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15L.  SOURCE.  LISTINGS 

QueRy,  Preprocessor  amd  Simple  Leg> 

A1OOR01  -  CTENl  .  PASES  1-8*} 


et  sys  f mal/t2for/moor01  forll 
program  MOOR0I 

************************************************************************ 

implicit  integer *2  (<*) 

mteger*2  screen  ,keybd  ,lu1  ,lu2  ,ni  v99  >siz99  ,ncpl 
integer*!  pref  I  (21  !  >dum1  ,ex  tlMl  ,ex  t2H  I  ,ex  1 3 1 1 1  ,ex  t  4  M  ) 
common  /LUNITS/  screen  ,keybd  ilu!  ,  1 u2 >m v99  ,s i 299  ,ncp!  , 

&  pref!  ,dum)  ,ext!  ,ext2  ,ext3  ,ext^ 

integer*2  gboff(2i)  ilugraf  iluptfl  iludbug 
common  /CCB/  gbuff  ilugraf  iluptfl  ,  ludbug 

integer*!  ctitle(IH) 
common  /TITLES/  ctitle 

integer*!  cdatim(!6) 
common  /DAT  I ME/  cdalim 

integer*!  cvarm(172l 
common  /VAR IN/  cvann 

i n  t  eger *  I  cvoro I ( 240 )  ,c varo2 (100) 
common  /VAROUT/  cvarol  ,cvaro2 

integer*!  cvarg(240l 
common  /VARG/  cvarg 

integer*!  cunkno(!2l 
common  /UNKNOU/  cun  k  no 

integer*!  cgroptmi 
common  /GROPT/  cgropt 

integer*!  cgrp21 (2!8!  ,cgrp22(82 I 
common  /GRP2CN/  cgrp2!  ,cgrp22 

integer*2  i I ib  ,ikey  ,iov 
integer* !  ons ( 1 ) 

integer*!  yes 
data  yes/  'Y '/ 

************************************************************************ 


I 


*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
ill b— 1 
ikevl 

100  com  inue 

coll  QUERY  ( 1 1  ib  ,i  key  iiov  ft  ■0,1  ,0) 

i 1 ib-0 

write! screen  ,*  I  'Do  you  wont  to  define  onother  leg  or  riser?' 

reed ( keybd  ■*  )  ons 

if  (ens(l)  eq  yes)  goto  100 

stop 

end 

* 


ro 


fl  ...  i,  m 


ei  sys  f mal / t2for/moor02  fort# 
program  MOOR02 

********** ************************************************************** 
implicit  integer*2  (“I 

integer *2  screen  .keybd  ,lul  ,lu2  ,nj v99  ,siz99  ,ncpl 
integer*!  pref  I  (21  1  ,dum!  ,ext  1  (4  )  ,ext2(4  )  ,exi3M  )  >exMM  I 
common  /LUNITS/  screen  .keybd  ,lu!  ,  lu2 >ni v99  ,s 1 299 >ncpl  . 

&  pref!  ,dum!  ■extl  .ex  1 2  .ex  1 3  ,ex  1 4 

integer*2  qbuf f <24  I  .lugraf  .lupt f I  .ludbug 
common  /GCB/  gbuff  .lugraf  , luptfi  , ludbug 

i n  t  eqer*2  1 1  eg  > i s  t  ,nco  ,ncb  .n»a  ,nwb  » i so 1  > i brnch  ,u2 ( 5 ) 
double  precision  z<67  I  ,cz  ,cx  ,d  ,ta  .tb 

common  /VCL08/  i  leg  ,ist  ,nca  .neb  ,z  ,c z  ,cx  ,d  ,ta  ,ib  .nwa  ,n«b  , 

<S  i  sol  ,i brnch  ,U2 

double  precision  pi  .halfpi  , degrad  .raddeg  .zero  , one  , ha 1 f 
i n  t  eger *2  i zero  ,  i one  ,  1 1 wo 

common  /VCONST/  pi  .halfpi  , degrad  ,raddeg .1  -one  .half  , 

&  izero  .ione  .it«o 

double  precision  tnaf.phif 
common  /VOFLR/  tnaf  .phif 

double  precision  delyk  ,twod  .hal fd  .dsq 
common  /VANCH/  del y k » t wod  ,hal fd  ,dsq 

integer *2  1 1 ib  , I  key >iov  .is* 
integer*!  ans ( 1 ) 

integer*!  yes 
data  yes/'Y'/ 

************************************************************************ 
*  BECIN  EXECUTABLE  CODE 

************************************************************************ 
cal  1  bfact (0  ,  M20LY  '  I 

i 1 ib- I 

i key-1 

100  cont  mue 

call  ovl  ink  (  'QUERY  '  >i  1  ib  >i  key  .iov  .1  .1  .0  .0 ) 


CM 


et  sys  f inal/t2for/bkdat  fori# 

BLOCK  DATA 

*********************************************************************** * 
implicit  integer*2  <**l 

inleger*2  screen  ,lieybd  (lul  ,lu2  ,niv99  >siz99  ,ncpt 
integer*  I  pref  1  (21)  ,dum1  ,ex  tlMI  iex  1 2  (4  1  iex  t  3 1 A  )  ,ex  till) 
common  /LUNlTS/  screen  ,keybd  ilul  > lu2  in i v99 >s i z99 >ncp)  i 
&  pre  f  I  idum  I  ,ex  1 1  ,ex  1 2  ,ex  1 3  iex  1 4 

in t eger*2  abuf 1(211  t  lug ra f  , lup t  f 1  >1 udbug 
common  /GCB/  gbuff  tlugraf  , luptfl  il udbug 

data  screen/10/ ,keybd/10/ ,lul /I  1/ ilu2/12/ 

data  ext!/'  VAR'/,ext2/'  LOC '/ >ex t 3/ '  ELV'/,ext4/'  PLN'/ 

data  ni v99/11/ iS i z99/768/ 

data  lugraf/l/  ilupt  f 1/3/ >1 udbug/ 14/ 


el  svs  f inal/t2for/query  fori# 

subrout  ine  QUERY  <  1 1  lb  >1  key  ,lov  ,iman  ,  i  *rc  ,ir  i  s  ,1  ldc  I 
************************************************************************ 
implicit  integer *2  (*>  1 

integer *2  1 1 ib  1 1 key  >iov  , iman  ,i»c >ir  i  s  . i ldc 

inreger*2  screen  ,keybd  ilul  , Iu2  ,ni v99  ,si299  ,ncpl 

integer*!  prefl  (211  ,dum!  ,ext  IMI  ,e*i2H  ) 

common  /LUN1TS/  screen  ,keybd  ilul  tl u2  ,n i v99  ,s i z99  ,ncp1  . 

&  prefl  ,duml  ,extl  ,ext2 

integer *2  qbuff(211  ,  lugraf  , luptfl  , ludbug 
common  /CCB/  gbuff  .lugraf  , luptfl  , ludbug 

mteger*2  npoint 
real  hmin  ,hmax  ,hsym 

common  /VHXCRV/  hm i n  ,hmox  ,hsym  ,npo int 

i n  t  eger  *1  t i t l e ( 50  I  ,  i f i 1 e ( 32  I  >o  f i I  • » ( 32  I 

common  /TITLES/  t 1 1 1 e  , i f i le  ,o f 1 1 e 

i ni eger *2  i2 f i le ( 1 6  )  ,o2f i le< 16  1 

equ  i  va  1  ence  (ifile,i2file)  >  ( o  f  i  1  e  >o2  file) 

integer*1  cdai iml 161 
common  /QATIME/  cdatim 

integer*!  cvarm(!721 
common  /VARIN/  cvann 

in t eger* 1  cvarol (210  I  ,cvaro2( 100  I 
common  /VAROUT/  cvorol  ,cvaro2 

integer*!  cvarg(210) 
common  /VARG/  cvarg 

integer*!  cunkno(!2) 
common  /UNKNOV/  cun k no 

integer*!  cgroptdll 
common  /GROrT/  cgropt 

integer*!  cgrp2 1 ( 2 1 8  I  ,cgrp22 ( 02  I 


common  /GRP2CN/  cgrp2 1  ,cgrp22 
integer*!  ansi  10) 

integer*2  i  ,j  (unk  I  ,alct99  ,lov  list  fi  leg  >nca  incb 

i  n  t eger* 1  blank  ,s  I  ash  ,uchar  ,yes  iundf  1 0(10)  >undf I  ,none  1 1 )  ,xzd  ( 3  ) 
equ i va 1 ence  I und  f 1 0  iund  f  1  ) 

data  blank/'  '/ ,s lash/ '/ ' / ,uchar/ 'U '/ iyes/ ' Y ' / , 

&  undf 10/ **********  '/ .none/ 'NONE '/ ,xzd/ 'XZD'/ 

************************************************************************ 
*  BECIN  EXECUTABLE  CODE 

************************************************************************ 
call  CF INI T 
call  chrs 1 2  I  3  ) 

if  ( 1 1 ib  eq  0  >  goto  1 10 
call  erase 

»r i te (screen  ,*  )  'Enter  library  name  ' 
read ( keybd  i*  )  prefl 
do  100  i  - 1  i2 1 

j-22-i 

if  (prefl Ij)  eq  blank)  goto  100 
ncpl - j ♦ 1 

prefl (ncpl l-slash 
goto  110 
1 00  com  inue 

ncpl -0 
1 10  cont inue 

call  um t99(siz99  .alct99l 
if  ( a 1 c 1 99  ne  01  stop  99 

do  150  i -  I  i32 

i f i le( i  )-blank 
1 50  con  1 1 nue 

if  1 1 man  eq  0 )  goto  1 000 

•r  i  te(  screen  !*  )  'Do  you  have  a  file  of  input  values'?' 
read! keybd  i* I  ans 
if  (ansi!)  eq  yes)  goto  1000 


I 


*  Manual  input  to  /TITLES/  and  lu99 

******************************************t***************************** 

i key- 1 

do  210  i-l  ,1 

i f  1 1 e ( i  )-none ( i  ) 

2 1 0  con  t i nue 

*rl  te<  screen  ,*  )  'Enter  leg/nser  title  ' 
readlkeybd  ,1  )  title 

*r i te (screen  ,*  )  'Enter  solution  type  (unit  less)  ' 

»r i te (screen  ,*  I  '  1  -  taut  leg  procedure’ 

*r i te (screen  ,*  )  '  2  -  slack  leg  procedure' 

readlkeybd,*)  ist 
»r i te (99  ,4  I  ist 

if  (ist  eq  2 )  goto  220 
i leg-1 
goto  22 7 
220  con  t i nue 

»r i te (screen  ,* I  Enter  type  of  leg  (unit  less)  ' 

»r i te (screen  ,*  )  '  I  .  simple' 

wr i t e ( screen  ,♦  1  2  -  compound  with  equalizer' 

wr i te ( screen  ,*  I  3  -  compound  with  spider  plate’ 

if  (iris  ne  11  goto  225 
wr i te (screen  ,*  ]  '  i  -  riser' 

225  cont i nue 

read ( kevbd  ,* 1  ileg 

if  (i leg  It  1  or  i leg  gt  1)  goto  220 
22 7  continue 

wr i te(99  ,4 )  i leg 

if  lileg  eq  1  or  i leg  eq  41  goto.230 

wr i te (screen  ,*  )  'Enter  horizontal  separation  between  anchors'  , 

4  ’  ( feet  )  ' 

call  RW 
goto  235 
230  cont inue 

write (99 >3)  undf!0 
235  cont inue 


212 


write (99  ,31  undfl0 
coni inue 


nco-2 

w r  i te (99  ,1  1  nco 
do  215  l-l  ,3 

wnte(99,3l  undfl0 
215  cont inue 

goto  520 

250  cont inue 

do  255  i-t  ,3 

do  252  j-1  ,3 

wn  telscreen  ,10)  xzd(j)  1  ,i 
col  I  RW 

252  cont  mue 

255  continue 

10  formot ( lx  , 'Enter  '  ,al  /-Coordinate  of  Point  ',i),lx, 

A  (feet)  ') 

if  ( i s t  eq  21  goto  500 
wr i te (screen  ,*  I 

write! screen  ,*  )  'Specify  two  of  the  remoining  voriobles' 
wr i l e ( screen  ,*  I  '(other  thon  number  of  segments  or  lood  direction) 
<5t 

wr i te (screen  ,*  )  'os  unknown  by  entering  the  code  U  ' 
wr i te (screen  ,*  ! 

************************************************************************ 
*  Leg  A  porometers 

************************************************************************ 
500  cont inue 

wr i te ( screen  ,*  )  'Enter  number  of  segments  in  branch  A'  , 

A  '(unit  less)  ' 
reod ( keybd  ,*  )  nco 
wr i te(99  ,1 )  nco 

if  ( i s t  eg  II  goto  510 
write (99  ,31  undf)0 
goto  515 
510  cont inue 

wr i te (screen  ,*  )  'Enter  slope  of  choin  of  oncbor  A  (AtA)', 

A  (degrees)  ' 
coll  RW 


-O 


515  com  inue 


En,er  len9'h  of  first  (lowest)  segment  of  A  ISIA) 

call  RW 

&"r (pounds/ f Cm  !  ;En’er  llnSar  *el9h'  °f  f,rS’  se9mon*  of  A  (W1 A ) 
call  RW 

l f  (nca  eq  1  )  goto  550 
520  cont inue 

wr i te (screen  ,*  )  ’Enter  weight  of  first  sinker  on  A  (CIA)’, 

A  ( k i ps )  ’ 

call  RW 

4*r ’ ( feeil6^  * '  En,er  Ien9,h  of  second  segment  of  A  (S2A ) * , 
call  RW 

&"r(poundC/fooM  *En'er  1,near  weight  of  second  segment  of  A  (W2AI 
coll  RW 

i f  (nca  eq  21  goto  560 

wr  i ite (screen  ,*  )  Enter  weight  of  second  sinker  on  A  (C2A)', 

&  l  K  l pS J 
col  1  RW 

&"r  ’  ( feen^0  *  '  En,er  len9,h  of  third  segment  of  A  ( S3A  )  '  , 
coll  RW 

A*r(pCiCCC/fCm)  ;En,er  W0,9h'  °f  ,h,rd  se9men  1  of  A  ( W3A ) 

coll  RW 
goto  570 

550  con  1 1 nue 

do  555  i « I  i3 

write<99,3)  undfl0 
555  continue 

560  cont  mue 

do  565  i-1  ,3 

wn  te<99  ,3)  undt  10 
565  cont  mue 

570  cont inue 

if  (ileg  eq  2  or  ileg  Bq  3)  goto  600 
wr 1 1  e 1 99  ,2 )  und  f 1  a 


580 


do  580  i-l  ,H 

write (99 >3)  undf10 
con  1 1 nue 

goto  (800,900),  isi 
**t*tt****t***t*t*t**t****tt***ttt*tt**ttt**tt**tt***tt*tttttt*ttttttt*t 

*  Leg  B  parameters 

*t**it*tt******ttt****tt**tt»t*t***t**t**tt**tt**tttt*$t***tt*tt**tz*ttt 

600  cont inue 

wr i te( screen  ,*  )  'Enter  number  of  segments  in  branch  B  (unitless)  ' 
read ( keybd  ,*  )  neb 
wr i te (99  ,i  I  neb 

if  ( i s t  eq  II  go t o  6 1 0 
wr i te(99  ,3)  undf 10 
goto  615 
610  cont inue 

wr i te< screen  ,* I  'Enter  slope  of  chain  at  onchor  B  (A1B  1 '  > 

4  ‘(degrees)  ' 
call  RW 
615  com  inue 

wri te( screen  ,*  I  'Enter  length  of  first  (lowest)  segment  of  B  (SIB) 
4  ( feet  1  ' 

call  RW 

wr t te (screen  ,* 1  Enter  linear  weight  of  first  segment  of  B  (WIB) 

4  (pounds/ foot  I  ' 
call  RW 

if  (neb  eq  1 1  goto  650 

wri te (screen  ,*)  'Enter  weight  of  first  sinker  on  B  (C 1 B  1 '  , 

4  '(kips)  ' 
call  RW 

wri let  screen  ,* )  'Enter  length  of  second  segment  of  B  IS2B)', 

4  '  ( feet )  '  ... 

call  RW 

wri tel screen  ,*  1  'Enter  linear  weight  of  second  segment  of  B  (W2BI 
4  (pounds/foot  1  ' 
coll  RW 

if  (neb  eq  2)  goto  660 

wr i te (screen  ,*T  'Enter  weight  of  second  sinker  on  B  (C2B  1 '  , 

4  '(kips)  ' 
coll  RW 

wr i telscreen  ,*  I  Enter  length  of  third  segment  of  B  (S3B ) '  , 


4  3  I  i 


&  ' ( feet  )  ' 

coll  RW 

write (screen  ,* I  ‘Enter  1  ineor  weight  of  third  segment  of  0  (USB! 

4  (pounds/ foot  I  ' 
coll  RW 
goto  700 

650  cont inue 

do  655  i-t  ,3 

write (99  ,3)  undf(0 
655  cont inue 

660  con  1 1 nue 

do  665  i-l  ,3 

write(99,3)  undfl0 
665  cont inue 

********************************************************************** ** 

*  Junction  ond  riser  porometers 

************************************************************************ 

700  cont  mue 

if  ( i 1  eg  ne  2 )  go l o  720 

wr i te (screen  ,*  )  Enter  initiol  slippoge  ot  equolizer  I  feet)  ' 
coll  RW 

wr i te (screen  ,*  I  ’Enter  friction  coefficient  of  equolizer', 

&  '(unit  less  ) 
coll  RW 
goto  730 
720  cont inue 

do  725  i-l  ,2 

write (99  ,3  I  undf!0 
725  cont  mue 

730  cont  mue 

wr i te (screen  ,*  )  'Enter  weight  of  equolizer  or  spider  plate  ( C  3  I  '  > 

&  ' l kips  1  ' 

col  1  RW 

wr i te (screen  ,*  )  'Enter  length  of  segment  above  junction  (S4I', 

&  ' ( feet  )  ' 

coll  RW 

wr i te (screen  ,* )  'Enter  linear  weight  of  segment  above  junction', 

&  '(W1)  (pounds/ foot  I  * 

coll  RW 
goto  900 


************************************************************************ 
*  Horizontal  load  and  displacement  in  taut  leg  case 
************************************************************************ 
800  con  1 1 nue 
unk I -5 

»r i te t screen  ,*  )  'Enter  magnitude  of  horizontal  load  (HI'  , 

4  '(hi lopounds  I  ' 
call  RW 

wr i te (screen  ,* I  'Enter  angle  from  neutral  direction', 

&  'to  horizontal  load  vector  (degrees)  ' 
call  RW 

write! screen  ,* I  'Enter  horizontal  distance  from  origin  to  buoy', 

4  '(feet)  ' 
call  RW 
do  8 20  i«l  ,3 

wnte(99,3)  undfl0 
820  continue 

wri te(99  ,1 )  unk I 
goto  2000 


************************************************************************ 
*  Choice  of  unknown  parameters  in  slack  leg  case 
************************************************************************ 
900  cnnl i nun 


905 


900  com  i nue 

if  ( 1 1 eg  ne  1 1  go t o 
unk I -4 
goto  940 
905  con  1 1 nue 

wr  i  te (screen  ,* ) 
wr I  re (screen  ,* ) 
wr  i  te (screen  ,* ) 
wr I ie( screen ,* I 
wr i te (screen ,* ) 
wr  i  te (screen  ,* ) 
wr i relscreen ,* ) 
wr  i  te (screen ,* I 
4  '  ( I  ,  2 ,  3  ,  or 

readtkeybd  ,* I  unk I 
goto  (910,920,930,940) 
stop  950 


You 


The 


must  specify  one  of  the  following  options  ' 

1  Hor i zon  t  a 1  1 oad  magn 1 1  ude  and  d i rec lion' 

2  Horizontal  displacement  and  direction’ 

3  Buoy  X  and  Z  coordinates  ' 

4  None  (system  solution) 
other  values  will  be  solved  ' 


'Which  option  do  you  wont  to  specify'  , 
4  I  (uni t less  )? ' 


unk  1 


9 1 0  con  1 1 nue 


wri te (screen  ,t)  ‘Enter  magnitude  of  horizontal  load  IH)', 

&  '(hit opounds  I  ' 

col  1  RW  ,  .  . ,  , 

wr i le (screen  ,♦  )  'Enter  angle  from  neutral  direct  ton  > 

&  'to  horizontal  load  vector  (degrees) 
call  RW 
do  915  i-l  ,4 

write (99  ,2)  uchar 

9 1 5  con  t i nue 

goto  999 

920  con t i nue 

do  92 2  i-l  .2 

write (99  ,2)  uchar 

922  continue  .  .  , 

wr i t e ( screen  ,*  1  'Enter  projected  horizontal  distance  from  origin  t 

Ao  buoy  (feet  I 
call  RW 

wr i te( screen  ,*  )  'Enter  direction  of  buoy  displacement  (degrees) 
call  RW 
do  925  i - 1  i2 

wr|te(99i2)  uchar 

925  com  i  nue 

goto  990 

930  cont i nue 

do  935  i-1  i4 

wr  1 1  e  ( 99  .21  uchar 

935  cont i nue  ,  .  , ,  .  , 

wri  lelscreen  ,*  I  'Enter  X-coordmate  of  buoy  I  feet  ) 
cal  1  RW 

wr i te (screen  ,<  )  'Enter  Z_coordinote  of  buoy  (feet) 
call  RW 
goto  990 

940  cont i nue 

do  945  I  - 1  >0 

write (99 >2)  uchor 

945  continue 


990  con  t i nue 

write(99)4l  unkl 
goto  2000 


r/V 


************************************************************************ 

*  File  read  to  /TITLE/  and  lu99 

************************************************************************ 

1000  continue 

i f  ( 1 k ey  eq  I )  goto  1 005 

»r t te (screen  ,*  )  'Same  input  file  as  before?' 
read I k  eybd  ,*  )  ans 
if  lansd  I  ne  yes)  goio  1005 
cal  1  RVC0M1 (II 
goto  1 050 
1005  continue 

if  (ncpl  eq  0)  goto  1015 
do  1010  i-l  ,ncpT 

1 f i lei t  )-pref I ( i  1 
1010  continue 

1015  con  1 1 nue 

»r 1 1 e (screen  ,*  )  'Enier  name  of  leg/riser  file  ' 
j-3l-ncpl 

read! keybd  ,*  1  i f i lelncpl H  )  j 
cal  1  AOOEXTI i f i le  ,31  ,ex 1 1  ) 

1050  continue 
i key-0 

coll  f i lei i2f i le  ,lul  ,2  ) 
read! lul  ,1  I  title 
read! lul  ,* ) 


do 

1 100  i-l  ,2 

read! lul  >* ) 

ans 1 1  ) 

wn  te(99  ,2) 

ans 1 1  ) 

1 100 

corn inue 

do 

1200  i-l  ,10 

read! lul  ,* ) 

ans 

wn  ie(99  ,3) 

ans 

1200 

cont inue 

do 

1350  j-1  ,2 

readl lul ,* I 

ans 1 1 ) 

wr  t  te (99  ,2 ) 

ans 1 1  ) 

do  1320  i-l 

,9 

read! lul  ,*  )  ans 
*ri te(99  ,3)  one 
1  320  con  1 1 nue 

1350  continue 


do  1-100  i-l  ,5 


reod! lul  , 

*1 

ons 

wr 1 1  e ( 99  , 

3) 

ons 

1 100 

con  1 1 nue 

do 

1500  1-1 ,6 

reod (lul  , 

*  1 

ons 

wr  1  te (99  , 

3) 

ons 

1500 

con  1 1 nue 

read! lul  ,* )  onsll  1  1 
wr  1 1  e  ( 99  >2 1  ons ( 1  1  1 
col  1  close! lull 

************************************************************************ 

*  Echo  data  for  editing  and  write  lu99  to  output  file 

*  Convert  lu99  to  numeric  values  in  /VAR IN/ 

*  Save  /TITLES/  and  /VAR IN/  in  file  T2TAB/C0MM0N  TAB 
************************************************************************ 

2000  continue 

call  ECHO! ikey >1 ldc >iov) 
if  ! 1 wc  ne  11  goto  2100 
call  CONVRT 
2100  continue 

cal  1  RVC0M1 (21 
call  close  1 991 
cal  1  erase 

call  HXQRY ( 1 ldc  .iov  ,iri8  1 
return 

1  format !50a1  1 

2  f  orina  flail 

3  format ( 10a1 I 
1  format (111 

end 


ooo  non  nno 


e»  svs  f Inal / 1 2 for/ g  f ini t  forff 

subr ou tine  g f i n 1 1 
c 

c  INITIALIZE  THE  GRAPHICS  CONTROL  TABLE 
c  ASSIGN  LOGICAL  UNIT  I  TO  THE  DEVICE  CONTROLLER 
c  FOR  CRAPHICS  OUTPUT  SET  DASH  PATTERN 
c 

implicit  integer*2  !*») 

c 

c  COMMON  BLOCKS 
c 

c  CCB 
c 

integer *2  gbuf f (21 1  .lugraf  .luptfl  >ludbug 
common  /gcb/  gbuTT  , lugraf  i luptfl  , ludbug 

LOCAL  VARIABLES 

integer*)  mask  I (2 ) 
integer*2  mask2 
equivalence  (mask  t  ( I)  lines  k  2  I 
data  mask  I /St  .51 / 

EXECUTABLE  PORTION 

call  assign! 'DC  '.lugraf  I 
ca  11  gl  ulTugraf ) 
coll  gcb ini! gbu f f I 
coll  of tochlgbuf f ) 

SET  DASH  PATTERN  (  —  -- 

call  doshm(maskl) 
return 
end 

* 


el  svs  f  inal/i2for/r*  forM 
subroutine  RW 

************************************************************************ 

implicit  integer*2  (») 

mteger*2  screen  , key bd  ,lu I  , lu2  ,niv99  ,siz99  ,ncp1 
integer*!  pref  1  (20)  ,ext  11(1  ,ext2M  I 

common  /LUNITS/  screen  , key bd  ■  I u!  ,  1 u2 >ni v99  ,s i *99  ,ncpl  > 

A  pref  I  ,ext  1  ,ext2 

integer*!  ans (10) 

*****************************************£1***************************** 

*  BECIN  EXECUTABLE  CODE 

************************************************************************ 

read  1 keybd >*  )  ans 
«r i te (99  .3  )  ans 
return 

3  format ( !0at  ) 


ei  sys  f mal/t2for/addext  for## 

subroutine  AODEXT ( f 1 le »n  ,ex t  ) 

************************************************************************ 

integer*?  n 

integer*!  f  i  1  e  (n  )  ,ex  t  H  I 

inleger*2  1  ,j 
integer*)  blank  , per i od 
data  blank/'  '/.period/'  '/ 

************************************************************************ 

*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
do  10  i  - 1  ,n 
J-n+1 -i 

if  (file(j)  ne  period!  goto  10 
goto  50 

! 0  cont inue 

do  20  i-l  ,n 
j-n* I  - i 

if  (file(j)  eq  blank  I  goto  20 

J-JH 

goto  50 

20  cont inue 

J-l 

50  cont inue 
do  60  i-l  ,4 

if  ( j  g t  n )  goto  1 00 
file ( j 1-ex  t ( i ) 

J-J*l 

60  cont  mue 

if  (j  gt  n)  goto  1 00 
do  70  i  -  j  ,n 

f 1 le! i ) -blank 
70  cont inue 

100  return 
end 


-O 


* 


et  svs  f inal / t2f or/echo  forM 

subroutine  ECHO! i key  , t Idc  ,iov 1 

implicit  integer*2  (») 

integer*2  i  key  ,i  Idc  ,iov 

integer*2  screen  ,keybd  ,lu1  i lu2  ,ni v99  ,si z99  ,ncpl 

i n i eger *  I  pr e  f I  1 2 1  I  ,dum 1  >ex  1 1 M I  ,ex 1 2  M  ) 

common  /LUNITS/  screen  ,keybd  ilul  ,lu2  ,niv99  ,siz99  ,ncpl  , 

&  prefl  ,dumt  ,ext1  ,exl2 

integer* 1  1 1 1 le (50  1  , i f i le (32 )  ,o f i le ( 32 1 
common  /TITLES/  title, ifile.o file 
integer*2  1 2 f i 1 e ( 1 6  )  ,o2T 1 1 e ( 1 6 ) 
equivalence  (ifileu2filel  ,  (of  i  le  ,o2T  i  le  1 

integer*!  cvarin(172l 
common  /VAR1N/  cvacin 

integer *2  i  ,j  ,j  I  ,j2  ,j3  ,nrec  ,nf  ,  imod  ,al  c  t99  ,  tech  Ml  1 
integer*!  ansi  10 )  ,codel3  )  .text  160  )  ,temp991 10  ! 

integer *2  n  f  orm  M  A  I  ,cirl  (7! 
integer*!  yes  .blank  .uchor  .zero  ,one 

data  nform/2*  I  .10*2  ,1  ,9*2  ,1  ,9*2  ,5*2  ,6*2  ,1/ 
data  ctrl/10  ,S*M  ,18/ 

data  yes/ 'V '/  , blank/ ’  '/ ,uchar/ 'U '/  ,zero/  '0  ’/ ,one/  '  I  '/ 

************************************************************************ 
*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
rewind  99 

do  100  nrec-l  ,nivQ9 

reod(99  .*  .err-900  l  temp99(1  ,nrec  1  10 
1 00  con  1 1 nue 

cal  I  close  1 99  I 

do  120  nrec-l  ,niv99 
ischlnrec  1-1 
con  1 1 nue 
iech!2i  1-0 
iech(H  1-0 


120 


-Z\ 


if  (ildc  ne  II  goto  130 
iech(38)-0 
iechM0  1-0 
I  30  con  t i nue 

i mod-0 

call  file!  'T2TAB/ECH0  TAB  ',lu1,2> 

200  cont inue 
rewind  lul 

wr i te (screen  ,*  I  'Oo  you  want  to  see  parameter  list  again"?' 
read! keybd  ,*  I  ans 
if  (ans(l)  ne  yes  I  goto  3000 

j-0 

if  (t  emp99 (1,1)  eq  one  I  j - 1 
lech ( 1 4 )-j* ( I  -  i  ldc  I 
j- 1 1  - j I*  1 1  - 1 Idc I 
do  420  nrec-41  ,43 
tech Inrec  l-j 
420  cont i nue 

cal  1  erase 

wr i te (screen  ,*  )  'TITLE  '.title 
wr i t e ( screen  ,*  I  'INPUT  FILE  '  ,i f i le 
*  wr i te (screen  ,* I 

do  500  nrec-l  ,niv99 

read! lul  ,  1 0  ,err-9l 0  , end-920  I  code, text 
if  (iech(nrecl  eq  0)  goto  500 

if  (nrec  eq  38  or  nrec  eq  40  or  nrec  eq  42 1 
A  wr i telscreen  ,*  ) 

wr i te (screen  ,1  I  1  nrec  ,code  ,temp99( I  .nrec  I  10,  text 
500  continue 

10  format  ( 3a I  ,1  x  ,60a I  ) 

1  I  format (lx  , i2 , 1 x  ,3a I  >2x  , 1 0a 1  ,60a 1  I 
goto  1000 
900  cont i nue 

wr i telscreen  ,* I  'EOF  on  buffer  lu99,  attempting  to  read  record', 
Inrec 

Stop 

910  cont i nue 

wr i t e ( screen  ,*  I  'Error  reading  from  file  ECHO  TAB  on  record'  ,nrec 
stop 

920  cont inue 


M 


wr ue (screen  ,*  1  'EOF  on  file  ECHO  TAB,  at tempting  to  read’, 
1  '  record  '  ,nrec 
stop 


1000 


2020 

2050 


coni  inue 

nr  lie (screen  ,*  )  'Do  you  want 
read ( keybd >* 1  ans 
if  (ans(1)  ne  yes  I  goto  3000 
i mod- I 

wr i te ( screen  ,* )  'Do  you  want 

readf  keybd  ,*  1  ans 

if  (ans(1)  ne  yes)  goto  2020 

wr 1 1 e ( screen  ,*  I  'Enter  new  ti 

read! keybd  ,1  1  title 

goto  2050 

coni inue 

wn  te  (screen  ,*  ) 

wr i te (screen  ,*  ) 

cont inue 


to  change  anything?' 
to  change  the  title?' 


t  le  ' 


wr i te (screen  ,*  I  'For  each  input  value  to  be  changed,  enter  variabl 
Ae  number,  followed  by  new  value  on  the  same  line,’ 
wr i t e ( screen  ,*  )  'with  one  new  value  per  line  To  terminate  new  in 
Aput  ,  enter  ''99''  followed  by  any  dummy  value 
wr i te (screen  ,*  )  'To  continue  when  display  is  full  ,  type  CTRL-N  fiv 
Ae  times,  followed  by  CTRL-R 
call  strmgfctrl  ,7  ) 


2100  cont inue 

read ( keybd  ,*  )  nrec  ,ans 
if  (nrec  gt  niv99)  goto  200 
do  2110  i-l  ,  1 0 

temp99( i  ,nrec )-ans( i  1 
2110  con  1 1 nue 

goto  2100 

3000  continue 

if  ( i ldc  eq  0)  goto  3100 
ans ( 1  1-zero 
do  3010  i-2  ,10 

ans ( i  ) -blank 
3010  cont inue 

do  3020  (-1  ,10 


r 


i emp99 ( i  ,38  )-ans ( i ) 

3020  continue 

ans ( 1  1-uchar 

if  ( temp99( I  ,1)  eq  one)  goto  3050 

JI-40 

j2-43 

j3-1 

goto  3055 
3050  coni  mue 
.  jl-14 

J2-40 

J3-26 

3055  com inue 

do  3075  j-jl  ,j2  ,j3 
do  3070  i-l  ,10 

temp99 ( i  ,j  l-ans  1 1  I 
3070  continue 

3075  continue 

3 1 00  con l i nue 

col  1  closet lul  1 
call  uni tgg (s i zg9  ,alc t9g  I 
if  1olci99  ne  01  stop99 
do  3150  nrec-1  ,niv99 


nf-n  f ormlnrec  ) 
go  to (31 10  ,3120 1  ,nf 


31  10 

cont inue 

3120 

wr  i  te  (99  ,2  1 
goto  3150 
com  inue 

t  emp99 ( 1 

,nrec  )  1 

3150 

wr  i  te(99  ,3 ) 
con  t i nue 

iov-0 

t emp99 ( 1 

,nrec 1  10 

if  tikey  eq  0  and  intod  eq  01  goto  4000 

wri te (screen  ,* )  'Do  you  want  to  sove  parameters  in  a  file?' 
read  (keybd,*)  ans 
if  (ans(i)  eq  yes  I  iov-1 

4000  cont inue 

call  OUTVARdov) 
return 

1  format (50a1 I 


l 


lu 


I 


et  svs  f tnal / t2for/convr t  fort# 
subroutine  CONVRT 

♦♦ft******************************************************************** 

implicit  integer*2  (») 

i n t eger *2  screen  ,keybd  ■  lul  , lu2 >n i v99  ,s i z99 >ncp1 

integer* I  pre  ft ( 2 1  I  ,dum  1  ,ex 1 1  M  )  ,ex  1 2  14  ) 

common  /LUNITS/  screen .keybd  i lu I  , iu2  ,n i v99  ,s i z99  ,ncp I  > 

&  pre ft  .dumt  ,extt  ,ext2 

integer* 1  1 1 1 1 e (50  I  ,  i f i le C 32  )  >of i 1 e ( 32 ) 
common  /TITLES/  1 1 1 le >i f i le  iof i le 
integer *2  i2f i let  16  )  >o2f i let  16  I 
equ i va l ence  lifile,i2filel  ,(ofile  .o2  file) 

integer *2  iileg.iist 
integer*^  nnca  ,nncb 
real  angl  a, anal  b, 

4  scopla  .scopTb  ,wgt la  ,wgt lb  ,c|mp1a  .clmplb  , 

4  scop2a  ,scop2b  ,wg  1 2a  ,*g  1 2b  ,c  I  mp2a  >c  1  mp2b  , 

4  scop3a  ,scop3b  ,wg  t  3a  ,*g  1 3b  is  1  i  p  >  f r  i  c  t  ,c  1  mp3  .scop*  .t*g  1 4  ,ank  sep  , 

4  p  1  x  ,p  I  z  ,p )  d  ,p2x  ,p2z  ,p2d  ,p3x  ,p3z  ,p3d  . 

4  hload  ,hdir  ,rbuoy  ,xbuoy  .zbuoy  .dept ho  .pdir 
common  /VAR IN/  i i lea  , i i s t  .nnco  .nncb  .angl a  .angl b  . 

4  scopla  .scop  lb  ,wgt  Ta  .ttgt  lb  .c  Imp  la  .clmplb  , 

4  scop2a  ,scop2b  ,wg 1 2a  >«rg 1 2b  .cl mp 2a  .C  1  mp2b  . 

4  scop3a  .scop3b  ,wg t  3a  .t»g 1 3b  >s  1  i p  . f r  i c  t  .cl mp3  ,scop4  .wg f  4  .ank sep  . 

4  pi  x  ,pl  z  ,ptd  ,p2x  ,p2z  ,p2d  ,p3x  ,p3z  ,p3d  . 

4  hload  .hdir  .rbuoy  .xbuoy  .zbuoy  .deptho  .pdir 
integer*2  unkset 
equivalence  (pdir  , unkset  1 

mteger*2  nunk  ,unkl  .unk2  .unk3  .unk4  ,unk5 
common  /UNKNOW/  nunk  ,unk 1  ,unk2 >unk3  .unk4  ,unk5 
i n  t  eger *2  unk  1 5  ) 
equivalence  (unkl.unk) 

integer*!  ansi  10) 
integer*2  1  ,nrec  >iu 
real  x (44  )  ,rdir 

double  precision  phih.xtot  ,ztot  .riot  .dsqrt 
double  precision  pi  .halfpi 


ro 


integer*!  undfl  >ucher 
data  undf 1 / ' * ' / >uchar/ 'U '/ 

************************************************************************ 

*  BECIN  EXECUTABLE  CODE 

************************************************************************ 

pi -3  M I S92653589793d0 
hal fpi-0  5d0*pi 
nunli  -0 
do  100  i  - 1  ,5 
unk ( i  1-0 
1 00  con  t i nue 

rewind  99 

do  200  nrec-1  ,niv99 
x ( nr ec  1-9999  99 
read(99,*l  ans 

if  (ansi  II  eq  undfl  I  goto  200 
if  ( ans ( I  I  ne  uchar  I  goto  150 
nunk -nunk  + 1 
unk (nunk  l-nrec 
goto  200 
1 50  coni i nue 

backspace  99 
read(99,*l  xlnrecl 
200  coni i nue 

i i s  t -x  (  1  I 
i i leg-x (2  I 
anksep-x (3  I 
p I x-x  M  l 
p1z-x(SI 
pld-x (6  I 
p2x-x ( 7  I 
p2z-x (8  I 
p2d-x (9  I 
p3x-x (101 
p3z-x III) 
p3d-x (I 21 
nnca-x (13) 
angl  a-x  (Ml 


scop2a-x 1181 
»gt2a-x ( 19 ) 
c Imp2a-x (20 ) 
scop3a-x (21  1 
wgt  3a-x (22  I 
nncb-x (23  I 
anglb-x (24  ) 
scoplb-x (25 ) 
wgi Ib-x (26  I 
clmplb-x (27  1 
scop2b-x (28 ) 

*gt2b-x(29) 
clmp2b-x (30 ) 
scop3b-x(31 1 
wgt3b-x (32 ) 
slip-x (33 ) 
fric i -x (34  ) 
clmp3-x(35  I 
scop4-x<36) 
wgt4-x(37) 
hload-x (38 ) 
hdir-x ( 39 ) 
rbuoy-x ( 10  ) 
rdir*x (411 
xbuoy-x (42 1 
?buoy-x (43 ) 
unkset-x(44  1 

goto  (300  |400  )  ,  list 
300  coni mue 

if  (nunk  ne  21  goto  500 
do  310  (-1  ,2 

if  (unk ( i  1  le  131  goto  500 

if  (unk(i)  ge  23  and  unk ( i  1  le  37)  goto  500 

i  f  (unk  ( i  1  eq  39  or  unk  ( i  1  ge  41)  goto  500 
3 1 0  con  1 1 nue 

unk set -5 
goto  1 000 
400  con  1 1 nue 

if  (nunk  ne  4)  goto  500 

if  (unkl  eq  40  and  unk4  eq  431  goto  510 
if  (unkl  ne  381  goto  500 

if  (unk2  eq  39  and  unk3  eq  42  and  unk4  eq  43)  goto  520 


et  svs  f inal/t2for/recom1  forM 
subroo » i ne  RVCOM I ( i o I 

************************************************************************ 

implicit  mteger*2  («*) 

mteger*2  10 

i n i sger *1  c l l • I e ( I M  I 
common  /TITLES/  ctitle 

integer*!  cdatim(l6l 
common  /DA TIME/  cdatim 

integer*!  cvarinl172! 
common  /VAR IN/  Cvar in 

i n  t  eger* !  c varo I ( 240 1  ,C varo2 1 ! 00 ) 
common  /VA ROUT/  cvorol  ,Cvaro2 

integer*!  cvarg(240l 
common  /VARC/  Cvarg 

integer*!  cunkno(t2) 
common  /UNKNOW/  conk no 

integer*!  cqropt(44) 
common  /CROPT/  cgropt 

integer*!  cgrp2l (2! 8  )  >cgrp22 (82  I 
common  /CRP2CN/  cgrp2l  ,CQrp22 

************************************************************************ 

*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
goto  (100  i200  I  , i o 

100  cont  tnue 

call  ft  let ' T 20 AT /COMMON  DAT'  ,9  ,21 

read (9  1  ctitle 

read (9 )  cdat im 

reod(9)  cvarin 

read (9)  cvarol 

read (9)  cvoro2 

read (9)  cvarg 


i  r 


et  svs  f inal/t2for/hxqry  forO 

************************************************************************ 
implicit  integer *2  I n  > 

integer *2  i ldc >iov  iiris 

integer*2  screen  ,keybd  , lul  >  1 u2  ,n i v99  ,s i *99  ,ncp1 
i n  t  eger *  I  pre  f  M  2 1  I  ,dum I  ,ex  t I < 4  )  ,ex  1 2  1 *  ) 
common  /LUNITS/  screen  ,keybd , lul  ,  1  u2  .n  i  v99  ,s  i  *99  ,ncpl  i 
A  prefl  ,duml  ,ex  t  I  .ext  2 


inleger*2  npoint 
real  hmm  ,hmax  ,hsym 

common  /VHXCRV/  hmm  .hrnax  ,hsym  .npoint 

in  t eger* I  title (50  )  ,  i  f i le 1 32  I  .o filet  32 ) 
common  /TITLES/  1 1 1 1 e  , i f i 1 e  .o f i 1 e 
integer*2  1 2  f  i  1  e  (  1 6  1  ,o2  f  i  le  1 1 6  1 
equ i va  1  ence  lifile.i2file)  >  ( o  f  1 1  e  >o2  f  i  I  e  ) 


t  n  t  eqer*2  i g  t  yp  /'da  t e  ,  i da  t  e ( 5  I  .  i hour  .  i m i n  .  i sec 

**************************************************** 


******************** 


*  BEGIN  EXECUTABLE  CODE 
********************************************* 


************************* 


** 


if  ( i ldc  eq  0 )  goto  200 
if  (  iov  eq  II  goto  110 
call  ADOEXTlifile  ,31  ,ext2l 


call  f i  let 1 2 f i le  .lul  .31 


goto  150 
l  1 0  com  mue 

call  ADDEXTlofi le  ,31  ,ext2) 
call  f i le(o2f i le  ,lul  ,31 


150  com  inue 


igtyp-1 

write! lul  ,4  l  igtyp 
write! lul  ,11  title 
cal  1  date (rdate  1 
call  undaietrdaie  , idate 1 
200  com  inue 

call  t ime! ihour  ,imin  ,isec  1 
if  (ildc  eq  01  goto  300 


I 


i  .  I 


or 1 1 e l lut  ,2 1  idate 

or  i  t  e ( lul  *3  1  ihour  iimin  »issc 


300 


500 


on  te (screen  ,*  I  Enter 
read ( lieybd  •*  I  hmin 
or i t e ( screen >*  )  'Enter  maximum 
read  I heybd <* 1  hroax 
or i te (screen  ,* )  'Enter 
read l heybd  .* >  hsym 
or i t e ( screen  ,* I  ‘Enter 
read l heybd  •* I  npoint 
cal  1  erase 
go i o  500 
continue 

if  (iris  eq  11  goto  500 
or i i e ( screen > 1 0  l  ihour  ,imin  iisec 
com  mue 
re t  urn 


minimum  value  of  H  (hips) 
v a 1 ue  of  H  (hips) 


value  of  H  for  reference  point 
number  of  points  to  be  plotted 


1  format (50a I  ) 

2  format (5o2  ) 

3  f or mat ( 1 2  . '  '  1 1 2 

4  f  orma  till) 

10  f ormat ( 1 x  , 'SOLU 
end 


>i2 ) 

ON  BEGUN  AT 


,  1 2  i '  •  1 2 


,  1 2 ) 


CJ 


1 


ei  svs  f inal/t2for/solve  for#* 
subroutine  SOLVE 

**************************************************** ******************** 
implicit  integer *2  (“I 

imeaer*2  1 1  <*g  list  ,nca  ,ncb  ,nwa  ,n«b  iisol  iibrnch  ,uz  15  ) 
double  precision  z (67  )  ,cz  ,cx  ,d  , t a  , t b 

common  /VGLOB/  i  leg  list  ,nca  incb  ,z  iCZ  ,cx  id  da  itb  ,nwa  inwb  i 
A  i sol  ,ibrnch  ,uz 

double  precision  pi  ,halfpi  , degrad traddeg  izero  , one  , ha  1 f 
integer *2  i zero  , i one  ,  i t wo 

common  /VCONST/  pi  ,halfpi  , degrad  .raddeg  (zero  , one  , ha  1 f  , 

A  izero  ,ione  , i two 

double  precision  inaf.phif 
common  /VOELR/  tnaf  ,phi f 

double  precision  delyk  itwod  ihal  fd  idsq 
common  /VANCH/  delyk  1 1 wod  iha 1 f d  ,dsq 

************************************************************************ 

*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 

call  ov 1 i nk (  'PRSL V  ') 

if  ( i leg  ne  II  goto  200 
if  ( i s i  ne  1  )  goto  120 
call  ov 1 i nk (  '  T  AUT  '  ) 
goto  150 
120  com  mue 

call  ovl ink  t  SLACK  'I 
1 50  com  inue 

call  ovl ink (  EPSLV  '  1 
goto  500 

200  com  inue 

cal  1  ovl ink ( 'CSLACK  '  ! 
call  ov 1  ink ( 'CEPSLV  ') 

500  com  mue 
return 
end 


et  sys  f inal/t2for/prslv  fortt 
subroutine  PRSLV 

tt*ttt*ttt*tt*tt****ttt*t***ttttt**tttttttt*t**ttt*t***ttttt***tt*ttttt* 

implicit  double  precision  <a-z) 

i n t eaer*2  i leg  , i s l  ,nca  ,ncb  .n»a  ,nwb  , i so  1  , i bench  ,uz (5 ) 
double  precision  z  (67  )  ,cz  .cx  ,d  ,ta  >tb 

common  /VCLO0/  i  leg  ,ist  ,nca  ,ncb  .z  ,cz  ,cx  ,d  >ta  ,tb  ,nwa  ,nwb  , 

A  i so  1  i  i brnch ,uz 
double  precision  za ( 25  )  >zb 1 25  I 
equ i valence  ( z ( I  )  ,za ( 1  II  ,  ( z ( 26  1  .zb ( I  )  I 

double  precision  ha  ,ala  ,va  .sla  .wla  ,c1a  .s2a  ,w2a  ,c2a  ,s3a  ,«*3 a  , 

A  xa  ,ya  ,x  1  a  ,x2a  .x3a  ,y  1  a  .y2a  .y3a  , 

A  t  ana2a  ,  t  ana3a  .  t  ana4a  ,  t  anaSa  ,  t  ana6a  ,  1  a  .ph i a 
equivalence  (za( 1  I  .ha  I  ,fza(2!  ,ala  ,va)  . 

A  ( za  ( 3  I  ,s  I  a  I  ,  l  za  ( 4  )  ,w  I  a )  , ( za ( 5  )  .cla)  . 

A  (za(6l  ,s2a)  ,  ( za  (  7  )  ,w2a  1  ,(za(8)  ,c2a  )  . 

A  (za (9  )  ,s3a  I  ,  ( za ( 10  1  ,w3a )  .  (za ( M  t  ,xa  )  ,  Iza ( 1 2  )  ,ya  )  , 

A  ( za  ( 1  3  )  ,x  I  a  )  ,  ( za  (  M  I  ,x2a  )  ,  ( zal  15  I  ,x3a  )  . 

A  (zal  16)  ,ylal  ,  (  za  1 1  7  !  ,y2a  )  ,(za(  18)  ,y3a)  , 

A  (  za  ( 1 9  )  ,  tana2a  I  ,  l  za  (20  I  ,  t  ana3a  )  ,  ( za  (21  )  ,  tana-la  )  , 

A  ( za ( 22  I  .  t  ana5a I  ,  ( za ( 23  I  .  t ana6a  )  ,  i za ( 24  )  ,1a)  ,  ( za 1 25  )  ,ph i a  ) 
double  precision  hb  ,a1  b  ,vb  ,s  1  b  ,w  1b  ,c  1  b  ,s2b  ,w2b  ,c2b  ,s3b  ,«*3b  . 

A  xb  .yb  ,xlb  ,x2b  ,x3b  ,ylb  ,y2b  .y3b  . 

A  i ana2b  , ' ana3b  ,  t  ana4b  ,  t  ana5b  ,  t  ano6b  ,  1 b  ,ph i b 
equ i valence  ( zb  1  I  )  ,hb  1  .  ( zb (2  )  ,al b  ,vb  )  , 

A  (zb  (3  I  ,slb  l  ,  <zb(-t  I  ,wlb  )  ,(zb(5  I  ,c!b  I  , 

A  ( zb (6  )  ,s2b  J  ,  1  zb ( 7  )  ,w2b )  ,(zb(8)  ,c2b  )  , 

A  (zb (9)  ,s3b  )  ,  ( zb ( 1 0 )  ,»*3b)  , (zb (  H  I  ,xb  )  . (zbl  12  )  ,yb  )  , 

A  ( zb  ( I  3  I  ,x  1  b  )  , ( zb ( 1 4  )  ,x2bl  ,  ( zb  ( 1 5  1  ,x3b)  , 

A  (zb 1 16  )  ,ylb  )  ,  ( zb  117)  ,y2b>  ,(zb(l8)  ,y3b)  , 

A  i zb (19)  ,  t ana2b  I  ,  ( zb ( 20  )  .  t ana3b  )  ,  ( zb ( 2 1  1  ,  t ana4b  )  , 

A  ( zb (22  I  .  tana5b  )  ,  (zb (23  )  ,  t  ana6b  )  ,  ( zb (24  )  ,1b  )  ,  I  zb (25  )  ,phib ) 
double  precision  coi  1  ,slp  ,frct  ,c3  ,s4  ,v*4  ,x4  ,y4  ,tana7  ,tana8  ,1  , 

A  h.phih.rtot  ,xtoi  ,Ztot  ,do 

equivalence  ( z (51  !  ,co  i  I  )  ,  ( z (52  )  ,s lp  )  ,  ( z (53  )  ,  fre  t  )  ,  ( z (54  I  ,c3  )  . 

A  (z(5S  )  ,s4  1  ,(z(S6  )  ,w4  1  ,  (  z  1 57  1  ,x4  )  ,(z(58  )  ,y4  )  , 

A  ( z ( 59  1  ,  t ano7  )  ,  1 z ( 60  )  ,  t ana8  )  ,  ( z ( 6 1  )  ,1  )  , 

A  (z(62)  ,h  I  ,(z(63)  .phihl  , 

A  <z (64  I  ,rtot  I  ,  ( z (65  )  >xtot  I  ,(z!G5)  ,ztot  )  ,  ( z (67 )  ,do ) 
double  precision  b  ,sinb  ,cosb  ,tanb  .seeb 

equivalence  (z(?5l  .b  1  ,(z(26)  .smbl  ,(zl27)  ,cosb )  ,(z(28)  .tanbl  , 

A  (z (29  )  ,secb  ) 


04 

-4 


mteger*2  luks 
equivalence  (uzl3l>iuksl 

double  precision  pi  .halfpi  .degrad  .raddeg  .zero  .one  ,hal  f 
mteger*2  i zero  ,ione  ,i  two 

common  /VCONST/  pi  , halfpi  .degrad  .raddeg  .zero  .one  ,  ha  I f  . 

A  izero  .lone  . i i»o 

double  precision  maf.phif 
common  /VOELR/  tnaf.phif 

double  precision  delyk  , t t»od  ,ha I  fd  .dsq 
common  /VANCH/  delyk  , I wod  .ha l fd  ,dsq 

integer*!  cl  1 1  let  1  M  ! 
common  /TITLES/  Ctitle 

integer*!  cdatim(16l 
common  /DAT1ME/  cdatim 

mteger*2  t  i  leg  ,i  i  si 
integer**  nnca  .nncb 
real  angla  .anglb  , 

A  scoplo  .scoplb  ,wgt !a  ,wgt 1b  .clmpla  .cimplb  , 

A  scop2a  ,scop2b  ,wgt  2a  ,wgt2b  .clmp2o  .clmp2b  , 

A  scop3a  ,scop3b  ,wg 1 3a  ,wgi 3b  .si  ip  ,  fr i c  t  ,c lmp3  .scop*  ,wgt  *  .anksep 
A  p  1  x  ,p  I  z  ,p  I  d  .p2x  ,p2z  ,p2d  >p3x  ,p3z  ,p3d  . 

A  hload  .hdir  .rbuoy  .xbuoy  .zbuoy  .depiho  .pdir 
common  /VAR IN/  1 1 1  eg  , i i s f  .nnca  ,nncb  .ongl a  ,ongl b  , 

A  scop  I  a  ,scop !  b  ,wg  t  T a  ,*rg  t  1  b  >c  1  mp  1  a  .c  l  mp  1  b  . 

A  scop2a  ,scop2b  ,wgt 2a  ,*gt2b  .clmp2a  .clmp2b  , 

A  scop3a  ,scop3b  ,*gt  3o  ,wqt3b  .slip  .frict  .clmp3  ,scop*  >wgM  .anksep 
A  plx  ,plz  ,p!d  ,p2x  ,p2z  ,p2d  ,p3x  ,p3z  .p3d  , 

A  hload  ,hdir  .rbuoy  .xbuoy  .zbuoy  .depiho  .pdir 
tnteger*2  unkset 
equivalence  (pdir  .unkset ! 

i n  t  eger* 1  cvarol (2*01  ,c varo2 (1001 
common  /VAROUT/  cvarot  ,cvaro2 

integer*1  cvorg<2*0) 
common  /VARG/  cvarg 


jnieger*2  nunk  ,unk(51 
common  /UNKNOW/  nunk  ,unk 

i n  r  eger *  1  cor op l 1 4 1 ) 
common  /CROPT/  cgropt 

integer*!  cgrp21 < 2 1 8 1  icgrp22 ( 82  I 
common  /GRP2CN/  cgrp2!  ,cgrp22 

,,«,.,;;;ff«ii.ii«w:;i«;;s;««;s««JE*.****»**.**«***»************** 

************************************************************************ 

i  leg-0 
t  s  t  -0 
ncO-0 
ncb-0 

do  80  i-l  *67 

z ( i J-0  0d0 
80  com  inue 

cz-0  0d0 
cx-0  0d0 
d-0  0d0 
t  o-0  0d0 
tb-0  0d0 
nwo-0 
nwb-0 
i sol -0 
i brnch-0 
do  90  1  - !  *5 
uz  1 1  )-0 

90  con  1 1 nue 

********************************** **************5**************** 

t leg-i i leg 
is»-i is* 


70 


*********** * ************************************************* *********** 

*  Set  values  of  standard  cons  I  on rs 

************************* *********************************************** 

pi -3  M1592653589793d0 
hoi fpi-0  Sd0*pi 
degrad-pi/180  0d0 
roddeg-180  0d0/pi 
zero-0  0d0 
one- I  0d0 
hoi f-0  5d0 
i zero-0 
i one- 1 
1 1  wo-2 

************************************************************************ 

*  Compute  vo lues  of  working  variables  determined  bv  ocean  floor 

************************************************************************ 

x I -pi x-p3x 

z 1 -pi z-p3z 

v 1 -p3d-p1 d 

x2-p2x-p3x 

z2-p2z-p3z 

y2-p3d-p2d 

de  t -x I *z2-x2*z l 

cx-  - (zl *y2-z2*yl l/det 

cz-  ♦ ( x I *y2-x2*y I  )/det 

do0-cx*p3x*cz*p3z+p3d 

mof-dsqr  t (cx*cx+cz*cz I 

i f  (cx  It  0  0d0 1  tnof-  -tnof 

if  (cx  ne  0  0d0 )  goto  110 

phi f-hal fpi 

if  (cz  It  0  0d0 )  phif-  -halfpi 
goto  115 
I  1 0  con  t i nue 

phi f-daian(cz/cx  ) 

1  1 5  con  t  t nue 

if  ( i 1 eg  ne  II  goto  300 

************************************************************************ 

*  Simple  leg  compute  trig  functions  of  effective  ocean  floor  angle 

**************************************************************** ******** 

ph i h-hd i r  *degr  ad 
t  onb-dcos ( ph i h-ph i f 1 *  t  no  f 


o 


secb-SECNT ( tanb ) 
s i nb- 1  anb/secb 
cosb- I  0d0/secb 
b-daf an( i anb I 
goto  1 000 

********************** t ****** ***************** ****** ******************** 

*  Compound  leg  compute  the  values  of  working  variables 

*  determined  by  anchor  separation  and  ocean  floor 

************************************************************************ 

300  corn inue 
d-anksep 
del yk-d*cz 
t  wod-d+d 
halfd-0  5d0*d 
dsq-d*d 

************************************************************************ 

*  Read  members  of  VAR IN  for  hardware  charac t er i s t t cs  and  other  potential 

*  unknowns  to  double  precision  array  z,  with  dato  conversion 

************************************************************************ 

1000  continue 
nco-nnca 
ol a-angl a*degrad 
s la-scop) a 
w 1 a-wg 1 1  a 

if  (nca  eq  1 l  goto  1010 
cla-clmpla*1000  0d0 
s2a-scop2a 
w2a-wgt2a 

if  (nca  eq  2)  goto  1010 
c2a-clmp2a*l000  0d0 
s3a-scop3a 
w3a-wgt3a 
1010  corn inue 

if  ( t l eg  ne  II  goto  1 200 

ha-h load* 1000  0d0 

ala-ala+b 

xa-rbuoy 

ya-do0 

goto  1 300 


I 


1200  continue 
ncb-nncb 
a 1 b-ang 1 btdegrod 
s lb-scop lb 
w I b-wg  t 1 b 

if  (neb  eq  II  goto  1210 
clb-clmplb*100w  0d0 
s2b-scop2b 
w2b-wgt2b 

if  (neb  eq  21  goto  1210 
c2b-c lmp2b*1000  0d0 
s3b-scop3b 
w3b«wgt  3b 
1210  corn  mue 
slp-sl ip 
frct-frict 
c3-c  lmp3*  1 000  0d0 
s4-scop« 
w4-wg  t i 

h-h|oad*l000  0d0 

ph i h-hd 1 r*degrad 

rtot-rbuoy 

xtot-xbuoy 

ztot-zbuoy 

do-do0 

************************************************************************ 

*  Test  for  presence  of  negative  weights 

************************************************************************ 

1300  continue 

nwa-NWGT (nca  >zo I 
if  (ileg  eq  1)  goto  1310 
nwb-NVGT (neb  ,zb T 
1310  con  1 1 nue 

************************************************************************ 

*  Compute  array  indices  for  unknown 

************************************************************************ 

numax-5 

do  1510  i-l  (Oumax 
uz ( i  1-0 

1510  continue 

do  1550  i-l  ,nunk 


•n 


u-unk ( i ) 

if  lu  eg  0!  goto  1550 
if  (ileg  ne  T)  goto  1520 
uz(  i 1-UMAP (u ) 
go  t  o  1 550 
1520  continue 

uz( i )-CUMAP(u1 
1550  continue 

coll  [SORT (uz  .numox  ,nunk  ) 
luks-unkset 

call  RWC0M1 (2) 

return 

end 

* 


Lm 


ei  svs  f inal/t2for/secnt  forM 
function  SECNT ( tongnt ) 

************************************************************************ 

implicit  double  precision  (a-zl 
double  precision  seen)  ,tangnt 

************************************************************************ 
secnt-dsqrt ( tangnt*tangnt+1  0d0 ) 
return 


et  sys  f mol/t2for/nwgt  forll 

»*«t««««*S*{i««**«****«««*************Mt***********M*** 

inteqer*2  n«gt  ,nc 

. . . . 


20 

100 


if 
i  f 
i  f 
i  f 
i  f 
i  f 


goto  1 00 

100 
100 


?f9'(zm  li  0  0d0>  . 

Inc  eq  <1  go'° 

IZlSl  It  0  0d0)  goto 
( z 1 7 )  It  0  0d0 )  goto 

Inc  eq  21  9°’ 2,  inn 

12181  H  0  0d01  9°’° 
(2(10)  It  0  0d0 )  goto  100 
cont inue 
nwgt-0 
con  r i nue 


et  sys  f mal/t2for/cumap  forM 
function  CUMAP(u) 

************************************************************************ 

integer *2  cumap  .u 

************************************************************************ 

if  (u  It  13  or  15  It  ul  goto  10 
cumap-u* 49 
goto  100 
1 0  cont inue 

if  (u  It  17  or  25  If  u)  goto  20 
cumap-u- 1 5 
goto  100 
20  cont inue 

if  lu  It  27  or  35  It  u)  goto  30 
cumap-u 
goto  100 
30  cont inue 

if  (u  It  36  or  40  It  u)  goto  100 
cumap-u* 1 6 
100  cont inue 
re i urn 
end 


et  sys  f mal/t2for/isor t  forM 
subroutine  ISORT(Oin^n) 

************************************************************************ 

implicit  integer *2  (a- 2) 

integer*2  n,m,a(n) 

************************************************************************ 
if  (m  le  1  )  goto  100 
do  50  k-2  ,m 
mk -m+2~k 
jmax-mk 
amax-a ( jmax ) 
do  10  j-2  ,mk 

if  (a(j-1)  le  amax  I  goto  10 
jmax-j- 1 
amax-a ( jmax  I 
10  cont inue 

if  (jmax  eq  mk  I  goto  50 
temp-atmk  ) 
a  1 mk  l-al jmax  ) 
a (jmax  1  -  temp 


et  svs  fmal/t2for/iaut  forft 
subroutine  TAUT 

**«»*«* ****************************************** *********************** 
implicit  inteaer*2  (»l 
implicit  double  precision  (a-z) 

mt  eaer*2  ileg.tst  ,nca  (ncb  ,n*a  ,n*b  nsol  .ibrnch  ,u2  15  ) 
double  precision  z  (67  I  ,cz  .ex  ,d  ,  ta  .  f  b 

common  /VGLO0/  i  leg  ,ist  ,nca  ,ncb  ,z  ,cz  ,cx  ,d  ,ta  ,tb  ,n*a  ,nwb  > 

4  isol  ,  i bench  ,uz 
double  precision  za<25  I  ,zb<25  1 
equivalence  ( z  1 1  )  izo 1 1  II  ( ( z (26  I  ,zb  ( 1  )  1 

double  precision  ha  ,al  a  ,va  ,s  I  a  ,w  I  a  ,c  I  a  ,s2a  >w2a  ,c2a  ,s3a  ,*3a  , 

4  xa  ,ya  ,x  I  a  ,x2a  ,x3a  ,y  1  a  ,y2o  ,y3a  . 

4  t  ana2a  ,  t  ana3a  ,  t  anal a  ,  t  ona5a  ,  t  ana6a  ,  1  a  ,ph i a 
equi valence  (zal 1  )  ,ha  I  , (za(2  1  >ala  .va  I  , 

4  (zal 3)  .si  a  I  ,  l zal 4  I  ,t*1a)  .  (za(5)  ,clal  , 

4  ( za  ( 6  l  .s2a  I  .  ( za  ( 7  I  ,w2o )  ,  ( za  ( 8 1  ,c2a  I  , 

4  (zal 9  I  ,s3a  )  .  ( zal  10  I  ,<*3o )  .(zal  1  1  )  ,xa  I  ,  l zal  1 2  )  ,ya  I  , 

4  (zal I  3  )  .xla  I  ,(za<  M  I  ,x2a  I  ,(za( 15 )  ,x3a  )  , 

4  (za(16l  ,y  1  a  l  ■  ( za  ( T  7  )  ,y2a)  .(za(18l  ,y3al  . 

4  (za(191  ,tana2a)  ,(za(20l  .iana3al  ,(zo(21  1  .tanaTa)  , 

4  lza(22l  ,tona5al  >(  zal  23  I  .tana6a)  .Izo  (24)  ,1a)  ,  l  zal  25)  .phial 
double  precision  hb  ,alb  ,vb  .slb  ,wlb  .clb  ,s2b  ,w2b  ,c2b  ,s3b  ,«3b  > 

4  xb  ,yb  ,x  lb  ,x2b  ,x3b  ,y  1  b  ,y2b  ,y3b  , 

4  t  ana2b  ,  i ana3b  ,  t  ano4b  ,  t  ona5b  .  t  ana6b  ,  I b  ,ph i b 
equ i va 1 ence  I  zb ( I  I  ,hb  I  ,  I zb ( 2  I  ,a 1 b  ,  vb )  , 

4  l  zb  1 3  I  .sib)  ,  ( zb  ( 4  I  ,*  1  b  I  .  ( zb  ( 5  )  ,c  1  b  )  , 

4  ( zb (6 )  ,s2b  I  .  ( zb ( 7 )  ,w2b  )  ,  ( zb ( 8 )  ,c2b  )  , 

4  I  zb  (9  I  ,s3b )  ,  I  zb  1 10  )  ,w3b)  .Izblll  )  ,xb)  ,(zb(12l  ,yb  )  , 

4  (zb(131  .xlb)  ,<zb(14l  ,x2b  I  .(zbdSt  ,x3bl  , 

4  I  zb  1 16)  ,y1b)  ,(zb(17l  ,y2b  )  ,(zbM8)  ,y3b)  . 

4  I  zb (19)  ,iano2b!  ,  (zb<20)  .  tana3b)  ,lzb(21  1  ,iono4bl  , 

4  I  zb  1 22 1  ,  rana5b )  ,  I  zb  1 23 1  >t  ana6b 1  .( zb  1 24  1  ,1b )  ,  ( zb (25  I  .phib ) 
double  precision  coi  1  .sip  ,frct  ,c3  ,s4  ,w4  ,x4  ,y4  ,tana7  ,rana8  ,1  , 

4  h  ,phih  ,rtot  ,xtot  ,ztot  ,do 

equivalence  ( z (51  I  ,coi 1  1  , 1 z (52  )  ,slp  I  > I z 153 1  , fre t 1  , 1 z (54 )  ,c3 1  , 

4  ( z  (55  I  >s4  I  ,  <z  <56  )  ,ir4  )  ,  (z  (57  )  ,x4  1  ,  (z  (58 )  ,y4  )  , 

4  ( z ( 59 1  .  t  ana  7 )  ,  ( z ( 60  1  ,  t  ono8 )  ,  ( z 1 6 1  1  .1 1  , 

4  ( z  ( 62  )  >h  )  ,  ( z  ( 63  )  ,ph  i h  1  , 

4  ( z  (64  1  .riot  )  ,  ( z  (65  1  ,x  t  o  t  I  ,  ( z  (66  1  ,z  to  t  )  ,  l  z  ( 67  1  ,do  1 

double  precision  b  ,sinb  ,cosb  . tanb  ,secb 

equ i  vo  1  ence  t  z  (25  1  ,b  1  ,  ( z  (26  1  ,s  mb  1  ,  (z  (27  1  ,cosb  1  ,  ( z  (28  I  ,  t  anb  I  , 


&•  <  z  (29  )  ,secb  ) 

mteyer*2  uzt  ,o z2 


equivalence  (uz( I  I  ,uzl  I  ,(uz(2)  ,uz2  I 

**BEG*N*E*E*UTAB*E**OOE *************************************** ********** 


******eps !**0d-*0******************************************************* 


i f  (uz2  qe  II)  goio  200 
epsl-eps*z( I  I  I 
eps2-eps*z< 12  ) 

coll  STEF2A(nca  ,zo  ,b  ,uzl  ,  uz2.eps!  ,eps2  ) 
go i o  500 

200  com  mue 

if  (uzl  ge  111  go i o  300 
i f  (uz2  eq  II)  goto  220 
eps 1 -eps*z (It) 
goto  250 
220  con i i nue 

eps 1 -eps*z ( I  2  l 
250  con  t i nue 

col  1  SEC  I  A  Inca  ,zo  ,b  ,uz  I  ,uz2  ,epsl  ) 
go i o  500 

300  con i i nue 

coll  CALC  I  Inca  iZO  I 


ei  sys  f i na 1 / 1 2  for/s t e f2a  for44 

subroutine  STEF2A  Inc  >z  ,b  >u1  iu2,eps1  ,eps2  ) 

************************************************************************ 

implicit  double  precision  (a-z) 

integer*2  nc.ul  ,u2 

double  precision  z(25lib,epst  .eps2 

double  precision  pi  .halfpi  .degrad  .raddeg  .zero  .one  .ha  1  f 
mteger*2  i zero  .  i one  ,  i t wo 

common  /VCONST/  pi  , halfpi  , degrad  .raddeg  .zero  , one  , ha  1 f  , 

A  i zero  ,  i one  ,  I  I  wo 

inieger*2  ni t 

************************************************************************ 
x  kn-z (11) 
dkn-z (12) 

call  CHS2A  (nc  ,z  ,b  ,u  I  .u2  .it  .  1 2  ) 
n  i  l  -  1 

200  l (ul  I  -  l  1 
z(u2l-t2 

col  1  CALC  t (nc  ,z  l 
x-z ( I  1  1 
d-z (12) 
de I x-x- x  K  n 
deld-d-dkn 

i f (dabs (del x  )  It  epsl  and  dabs (de Id  I  li  eps2)goto  500 
if (nit  eq  100  1st  op  100 

i f (ni t  eq  I  ) goto  300 

del 1 1  - ( j 1 Udelx+j 12*deld)*det j*dsqrt ( j2 1 *j2! ♦ j22*j22  ) 
del 1 2- ( j21 *delx  +  j22*deld)*det j*dsqrt ( j II  * j II ♦ j 1 2*j 1 2  I 
goto  310 

300  de 1 1 I -dsqr t (0  5* (de 1 x*de I x+de 1 d*de 1 d  )  ) 
del f 2-del t 1 
310  cont inue 

alpha) -I  0d0 
i f l u 1  ne  1  Igoto  320 
i f ( 1 1 +  de 1 1 1  gt  0  0d0  Igoto  320 
alphal-  -0  5d0*tl/delt1 
320  cont  mue 

alpha2-l  0d0 


i  Hul  ne  2  (goto  330 
i f tdobsl t 1 +del t II  It  halfpilgoto  330 
i fill »del t 1  gt  0  0d0 (goto  322 
bound- -ha  1 fp i 
goto  325 

322  bound-holfpt 

325  a  1 pha2-0  Sd0* (bound- t 1  I/del t 1 
goto  340 

330  com  inue 

if(u2  ne  2  (goto  3-10 
i f <dabs< t2+de! t2  I  It  halfpilgoto  340 
iMt2*delt2  gt  0  0d0)goto  332 
bound- -ha  1 fpi 
goto  335 

332  bound-halfpi 

335  a  1 pha2-0  5d0* (bound- t2 )/del  t2 

340  con  i  i  nue 

alpha-olphal 

i f ( a  1 pha2  It  a  1 pha ) a  1 pha-a I pha2 
delt! -alpho*del t 1 
del t2-olpha*del t2 

z  (ul )- t 1 +del t 1 

z(u2)-t2 

col  1  CALC  I (nc  , z  ) 

x  1  -z ( 1  I  ) 

dl -z  M  2  ) 

z (ul  I- 1 1 

z (u2 l-t2+del t2 

col  1  CALC  1 (nc  >z I 

x2- 2(1 1  I 

d2-2(!2) 

jl I  - ( x 1 -x  )/del t 1 
j I2-(x2-x 1/del t2 
j21 - (dl -d  I/del t I 
j22- td2-d  )/de 1 1 2 
det j-jl 1*j22-jl2*j2l 
temp- j I  I 
j 1  I  - j22/de i j 
j22-temp/det  j 
jl2-  -j12/detj 
j2l-  -j2I/detj 


chng 1 1  -  - ( j II *de I x ♦ j I 2*de i d I 
chngi2-  - ( j2 1 *de I x+ j22*de 1 d I 

alphal-1  0d 0 
i f ( u 1  ne  I  Igo i o  420 
i fill ♦chng tT  gi  0  0d0lgoto  420 
alpha)-  -0  Sd0* i I /chngi I 
420  con  l  i  nue 

alpha2-l  0d0 
iflul  ne  2) goto  ■130 

i f l  dabs ( i I *chng ill  1 i  ha  I f  p i  Igo i o  430 
iflil+chngtl  gi  0  0d0)goio  422 
bound-  -halfpi 
goto  425 
422  bound-halfpi 

425  alpha2-0  5d0* ( bound- l I  I /chngi  I 
4  30  coni  mue 

i  f  <u2  ne  2  I  go  to  'H0 

i  f  (dabs!  t2*chngi2  )  li  halfpi  Igoio  '"40 
i  f I l 2+chng l 2  gi  0  0d0  Igoio  432 
bound-  -halfpi 
goto  435 
432  bound-holfpi 

435  alpha2-0  Sd0* (bound- i2  )/chngi2 
4  40  con  I i nue 

alpha-alphai 

if(olpha2  It  alpha  Ialpha-alpha2 

Chngi I -alpha*chngt 1 
chng 1 2-alpha* chng 1 2 
l I  -  I  I +chngi 1 
i 2- l2+Chngt2 

ni  I  -m  l  ♦  I 
go l o  200 

500  coni i nue 

z ( I  I  )-xkn 
*( 121-dkn 
r  e  i  uc  n 
end 


I 


13 


On 

CM 


I 


et  s vs  f mal/i2for/chs2a  for»» 

,,„,,S*««*««*m*«««*««««*««««««**««*«**t************ 

implicit  double  precision  (o-Z  I 

i n i eger*2  nc  ,u1  ,u 2 

double  precision  z <25  )  ,b  ,  > 1  »t^ 

mieaerll  name  (2,1  21 

double  precision  pi  , hoi fpi  , degrad  .roddeg  .zero  , one  , ho  1 f 
inteaer*2  i zero  . i one  , i t wo  .  . 

common  /VCONST/  pi  .hoi fpi  .degrad  .raddeg  .zero  .one  ,hol f  . 

A  i zero  .  lone  ,  i t  wo 

write  (10,*)  'Enter  initial  guess  for  .namel'.ui)  £ 

wr??e* !?0** 1 '  Enter  initial  guess  for  '  .name  1 1  ,u2  I  2 

goTol  1  10  1*20 '.f 50  ,150  ,1  10  .150 ,150 .1  10 ,150 ,150 ,150 ,1501  ,ul 
110  t I  - t 1  *  1 000  d0 
goto  150 

120  t  1  -  1 1  *degrachb 

150  go?o(210  ,220  ,250  ,250  ,210  ,250  ,250  ,210  ,250  ,250  ,250  ,250)  ,u2 
2)0  1 2- 1 2* ) 000  0d0 
goto  250 

220  t2-t2*degrod+b 
250  cont inue 
return 
end 


0\ 

-f- 


et  svs  f inal/t2for/secle  for*» 

***,**i^?*;i^*i*i*i?*******i**************************************** 

implicit  double  precision  la-h,o-zl 

integer *2  nc  .u!  >u 2 

double  precision  z(25),b.eps 

double  precision  pi  .halfpi  , degrad  -raddeg  .zero  , one  , hoi f 
inteqer*2  i  zero  .  i one  ,  i f *o 

common  /VCONST/  pi  .hal fpi  .degrad  .raddeg  .zero  .one  ,hal r  , 

&  izero  aone  . i two 

»**,**i5«?«M*«?U********«*M**************M********M******«**** 
i f (u2  ne  1 1 Igoto  110 
k-12 

goto  120 

I  10  i f (u2  ne  121goto  120 
k-1  1 

1 20  coni inue 
f  kn-z ( k  ) 

cal  1  CHS1  Mnc  ,z  ,b  ,u1  ,«j2  , 1 0  , 1 1  » 

z (ul  1-t0 

col  1  CALC1 (nc  ,z 1 
f0-z  t  k  1 
z (ul  )-f 1 

cal  1  CALC  1 (nc  ,z I 
fl-z(k  1 
n  i  t  -  1 

200  cont inue 

i2-t1-(fl-fkn)*(t1-t0l/lf1-f0) 


i f (ul  ne  1  Igoto  210 
i f 1 12  gt  0  0d0  Igoto  210 
1 2-0  1 d0*  1 1 
2>0  cont inue 

i f (ul  ne  2 Igoto  220 
ifldabslt2)  It  hal fpi igoto  220 
i f ( i2  gt  0  0d0)goto  212 
bound-  -hal fpi 
goto  215 


el  svs  f  mal/»2for/chs!a  forli 

subrou  line  CHS  I A  ( nc  ,z  ,b  ,u  I  ,u  2 , 1 0 . 1 1  ) 

***  ********************************************************************* 

implicit  double  precision  la-? I 

integer *2  nc  ,u I  >u2 

double  precision  z  1 25  1  ,b  .  1 0  ,  t  I 

double  precision  pi  ,hel fpi  .degrad  .raddeg  .zero  .one  , ha  1  f 
integer*2  i zero > tone  , i t wo 

common  /VCONST/  pi  ,hal fpi  , degrad  .raddeg  .zero  .one  , ha 1 f  , 

A  i zero  ,ione  , i  two 

integer*!  name (2  .12) 
integer*2  u 

data  name/' H  A1SIW1C1S2W2C2S3V3X  0  '/ 
************************************************************************ 
write  (10,*)  'Enter  two  initial  guesses  for  ’.namell.u!)  2 
read  ( 10  ,*  I  t0  ,t ! 

u- (ul -  !  )* (u! -5 )* (ul -8  ) 
i f lu  ne  0 Igoto  100 
t0-t0*1000  d0 
t 1  - t 1  *  1 000  d0 
100  coni  mue 

i f(ul  ne  2  Igoto  200 
t0- t0*degrad*b 
t 1  - 1 1 *degrad*b 
200  continue 

re  t  urn 
end 

* 


et  sys  f  inol/»2for/c<alcl  forM 

************************************************************************ 

implicit  double  precision  (a-h,o-z) 
integer*2  nc 

«**M******************************************************************* 
hurl  -Z  (  I  I/Zd  ) 
t  ana  I -d  t  on ( z 1 2  )  ) 
sec  1 -SECNT 1 1  ana 1  ) 
z ( 19  I- tana 1 »z (3 I /hurl 
sec2-SECNT(z( 19) ) 

z  ( I  3  )-h«*1  *dlog(  lz<  19  )+sec2  )/< tana  I  +secl  )  ) 

z  < 1 6  )-hw 1  * (sec2-sec I  1 

i f  tnc  eq  I  I  go to  100 

hw2-z ( I  )/z</  I 

z(20)-z(l91+z(5)/z(l  I 

seel -SECNT (z (201 l 

z (21  )-z<20)>z(6l/hw2 

sec2-SECNT(z(2l  I  1 

z ( M  )-hw2*dlog( (z(21  I  +  sec2  I / ( Z  < 20  1  +sec 1  ) ) 

z  ( 1  7  l-hw2*  (sec2-sec  I  l 

i fine  eq  2lgoto  200 

h«*3-z(1  )/z(l0l 

z  122  )-z 121 l*z(8)/z(l  l 

sec  I -SECNT (z (22 l I 

z(23)-z(22)*z(9l/hw3 

sec2-SECNT(z(23i 1 

z( 15  )-hw3*dlogl (z (23 >  +sec2 )/ (z 122 )+secl  ) ) 
z ( 18 )-hw3* (sec2-secl 1 
z( 1  I  )-z( I3)*zl M l*z 1 15 1 
z(121-z(16l»ztl7)+z(l81 
goto  500 

100  z( ll)-z( 13) 
z( I2)-Z(16) 
goto  500 

200  zdl  )-z  1 1  3  )  +  z  (  M  1 
z(l2)-z(16)*z(17) 


500  return 


end 


ei  sys  f  inal/i2for/slacli  fort# 
subroutine  SLACK 

************************************************************************ 

implicit  inteaer*2  ("I 
implicit  double  precision  (a-z ) 

i n t  eaer*2  i  leg  ,  i  s  t  ,nca  ,ncb  ,n*a  ,nwb  1 1  so  1  >  i bench  ,uz  (5  ) 
double  precision  z (87  1  ,cz  ,cx  ,d » t a  , tb 

common  /VGLOB/  i  I  eg  ,  i  s  t  ,nca  ,ncb  ,z  >cz  ,cx  ,d  ,  t  a  ,  t  b  ,nwa  ,nwb  , 

A  i so  1  ,  i brnch  ,uz 
double  precision  za (25  )  ,zb (25  I 
equi valence  ( z ( I  )  ,za (I  1  )  > ( z (26  1  ,zb ( 1  )  ) 

doub  1  e  prec  i  s  i  on  ha  ,a  I  a  ■  va  .s  t  a  ,w  I  a  ,c  1  a  >s2a  ,w2a  .c2a  ,s3a  ,w3a  , 

A  xa  ,ya  ,*  1  a  ,x2a  ,x3a  ,y  t a  ,y2a  ,y3a  , 

A  t  ana2a  ,  I  ana3a  ,  t  anala  .  t  anaSa  1 1  ana6a  .  1  a  ,ph  i  a 
equivalence  (za(l  I  ,ha  I  ,(za(2l  ,a(a,va)  , 

A  ( za  1 3  )  ,s  I  a  )  ,  ( za  M  I  ,wl  a  1  ,  tza(S  I  ,c  1  a  )  , 

A  ( za ( 6  )  .s2a  1  ,  ( za ( 7  )  ,w2a  >  ,  ( za ( 8  )  >c2a  )  , 

A  (  za(9  )  ,s3a  )  ,  Iza  ( 1 0  )  ,«r3a  I  ,  ( za  (  H  !  ,xa  I  ,  l  za  1 1  2  )  .ya  )  , 

A  ( za  ( 1  3  )  >x  1  a  )  ,  ( za  (  II  I  ,x2a  I  >  l  za  (151  ,x3a  )  > 

A  ( za  ( 1 6  1  ,y  l  a  I  ,  ( za  ( I  7  1  ,y2a  )  ,  ( za  ( 1 8  I  .y  3a  >  , 

A  l za ( 1 9  I  ,  t  ana2a  I  ,  ( za ( 20  I  ,  i ana3a  )  ,  ( za I  2 1  )  .  t  anala  >  , 

A  ( za (22  l  ,  t  anaSa  1  ,  ( za (23  I  .  tana6a  )  > ( za (21  )  ,1a)  ,  1 za 125  )  ,ph ia  ) 

double  precision  hb  ,a(b  ,vb  ,slb  ,wlb  ,ctb  ,s2b  ,»2b  ,c2b  ,s3b  ,«3b  , 

A  xb  ,yb  ,xlb  ,x2b  ,x3b  ,ylb  ,y2b  ,y3b  , 

A  t  ana2b  ,  t  ana3b  ,  t  analb  ,  t  ana5b  ,  t anaSb  ,  I b  ,ph i b 
equivalence  ( zb ( 1  )  ,hb  I  ,  (zb ( 2  I  ,atb  ,vb  )  , 

A  ( zb  ( 3  )  ,s lb  )  , !  zb  ( 1  l  ,wl b  I  ,  (zb  (5  I  ,c  lb  )  , 

A  (zb(6)  ,s2b  I  ,(zb(7l  ,w2b  I  ,(zb(8)  ,c2b  )  , 

A  l zb (9  1  ,s3b  I  ,  ( zb (10)  ,«*3b  I  ,  ( zb ( I  I  I  ,xb  )  ,  (zb ( 1 2  )  ,yb  )  , 

A  lzb(13)  ,xlb)  ,  l  zb  (Ml  ,x2b  I  ,  ( zb  ( 1 5  I  ,x3b  1  , 

A  ( zb  ( 1 6  )  ,y  I  b  )  ,  ( zb  ( I  7  I  ,y2b  I  >  ( zb  (181  ,v3b  )  , 

A  ( zb ( 1 9 1  ,  t  ana2b  I  ,  ( zb 1 20  I  ,  t  ano3b  1  ,  ( zb ( 2 1  )  ,  t analb  I  » 

A  (zb (22  I  ,  tana5b  )  ,  (zb (23 1  ,  tana6b )  ,  ( zbl 21 )  ,1b )  ,  I  zb ( 25 1 ,phib 1 

double  precision  coil  ,slp  ,frct  ,c3  ,sl  ,»*1  >x1  >y1  ,tana7  ,tana8  ,1  , 

A  h,phih,rtot  ,xtot  ,ztot  ,do 

equivalence  ( z (5 1  )  ,coi 1  1  ,  (z (52  I  ,s Ip  1  > ( z (53  )  ,  fre  t  I  ,  (z (51 )  >c3  I  , 

A  (  z  (55  I  ,s1 1  ,  ( z  (56  I  ,w1 )  ,(z(57)  ,x1)  ,(z(58l  ,y1>  > 

A  ( z ( 59  1  ,  t  ano  7  !  ,  ( z ( 80  I  ,  t  anaB  )  ,  ( z ( 6 1  )  ,  1  )  , 

A  ( z  ( 62  I  ,h  1  ,(z(63l  ,phih)  , 

A  (z (61 1  ,r  tot  I  ,  ( z (65  1  ixtot  I  , (z (66  I  ,z tot  1  ,  Iz 167 )  ,do I 
double  precision  b  ,smb  >cosb  ,tanb  ,secb 

equivalence  ( z  (25  )  ,b  I  ,  ( *  (26  1  ,s mb  I  , ( z  (27  )  ,cosb  )  ,  I z  (28  )  >t anb  I  , 


&  (z (29  I  ,secb  I 
m»eger*2  uzl  ,uz2,iulis 

equivalence  (uz(l  I  >uzt  )  ,(uz(2)  ,uz2 )  ,(uz(3)  ,iuhs) 

*************************** ********************************************* 

*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
eps-1  0d-10 

if  I tuhs  eq  1 )  goto  200 
eps I -eps*z 1 1 1  ) 
eps2-eps*z( 12 ) 

call  STEE2V(nca  ,za  iSinb  ,cosb  i  »anb  ,secb  , eps I  .eps2  ) 
goto  500 

200  coni  mue 

epsl -eps*z (121 

cal  1  SECiVfnca  .za  ,sinb  .cosb  .tanb  ,secb  .epsl  ,t  ) 

500  com  inue 
re  t  urn 


e»  sys  f inal/t2for/stef2v  for#! 

subroutine  STEE2V (nc  ,z  iS ! nb  ,cosb  1 1 anb  ,secb  ,eps 1  ,eps2  ) 

************************************************************************ 

implicit  mteaer*2  (“1 
implicit  double  precision  la-z  I 

inteaer*2  nc 

double  precision  z (2S  )  ,sinb  icosb  , tanb  iSecb  ,eps 1  ,eps2 

double  precision  pi  .halfpi  ,degrad  iraddeg >zero  ,one  .hal f 
mteger*2  i zero  , lone  , i t no 

common  /VCONST/  pi  ,hal fpi  .degrad  ,raddeg  .zero >one  ,ha 1 f  , 

&  i zero  ,ione  , i two 

double  precision  vc0(6l 
equivalence  (vc0,vc0!l 
integer*2  i  ,is  ,ni  t  .nerr  ,nr 

*************** ******* ************************************************** 

*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 

call  VCRI T0(nc  ,z  ,vc0  1 
xkn-z (II) 
dkn-z (121 
epsx-xkn*l  0d-5 
epsy-dkn*l  0d-5 

h0-vc0 I 
z ( 1 )-h0 

call  SEC  I  V  (nc  ,z  ,s  mb  .cosb  ,  tanb  .secb  ,epsy  .0  ) 

x0-z (111 

hi -hal f*h0 
z ( 1  l-hl 

cal  1  SEC  1 V (nc  ,z  ,s mb  .cosb  . t anb  .secb  .epsy  .0 1 
x l -z ( 1 1  1 

m  t  - 1 

1 20  cont inue 

h-hl - (xl -xkn  ) * ( h 1 -h0  1/ txl -x0 ) 
if  (h  le  zero)  h-half*hl 

Z  (  1  ) — h 

cal  1  SEC  1 V  (nc  ,z  ,s  mb  ,cosb  ,tonb  ,secb  .epsy  .0  ) 
x-z  1 1  1  ) 

if  (dabs(x-xkn)  It  epsx  or  nit  eq  20)  goto  150 


y 

O 


z 


h0-h1 
X0-X  1 
h  1  -h 
x  I  -x 

n  i  t  «m  l  ♦  1 
go  t  o  1 20 
1 50  corn inue 
v-z(2) 


n  i  t  -  1 

200  coni inue 
z(  1  ) -h 

2 1 0  con f inue 

call  C  ALC2  ( nc  ,z  ,vc0  ,sinb  ,cosb  ,ianb  ,secb  ,hianb  ,2  ,nerr  ) 
if  (nerr  eq  0)  goto  215 
nr-nerr-nerr/3 
v-VFUNI vC0lnr )*bronb ,b ) 
goto  210 
215  coni inue 
x-z(  11  ) 
d-zl  12) 

de I x-x-xkn 

'jVfdabstdelxl  It  epsl  and  dabstdeld)  H  eps2 )  goto  600 
if  (mi  eq  100  1  slop  100 


300 

3)0 

315 


if  (nit  eq  1  1  goto  300  _  . 

delh-( jl l*delx* jl2*deld)*dsqri (j21*j21»j22*j22  *det j 
del v- ( j21 *del ** j22*deld  l*dsqr i ( j I  I *j 1 1 ♦ j I2*j I  2  ltdeij 

goto  310 
conti nue 

delh-dsqr  t lhal f* (delx*del x*deld*deld  )  ) 


de 1 v-de 1 b 
corn  mue 

if  (tonb*delb  le  zero!  goto  31b 
delh-  -delb 
del v-  -delv 
com  mue 

if  (h*delb  at  zero)  goto  550 
nlpho-  -bo) 7*b/delh 
delh-alpbo*de lh 
del v-olpba*del v 


(T' 


350  coni inue 


alpho-one 
zll  )-h 

■100  coni  inue 

z 1 2  )-v+del v 

cal  l  CALC2lnc  ,z  .vc0  .sinb  >cosb  ,tanb  .secb  ,hianb  ,2  ,nerr  ) 

if  (nerr  eq  0)  goto  120 

nr-nerr-nerr/3 

dv-hal ft ( vc0 (nr  I +h t anb- v ) 

alpha-dv/del v 

de I v-dv 

goto  100 

120  com  inue 
xv-H (lil 
dv-z (12) 
delh-alpha*delh 
z( I  )»h+delh 

z (2  1-v 

cal  1  CAl_C2tnc  ,z  ,vc0  .sinb  ,cosb  ,ianb  ,secb  .hianb  .2  ,nerr  ) 

vh-zl  1 1  ) 
dh-z (12) 

j 11  - l xh-x  ) /de 1 h 

j 1 2- 1 x v-x  )/del v 

j21 - (dh-d  I/de  1 h 

j22- (dv-d  )/de I v 

deij-jl 1*j22-j12*j21 

<emp-J 1 1 

j 1 1 -j22/det  j 

j22-iemp/det j 

jl2-  -j12/deij 

j21-  -j21/detj 

chngh-  - ( j  1  1 *del x  + j 1 2*del d ) 

chngv-  - ( j2 1 *de 1 x* j22*de Id  I 

if  Th*chngh  at  zero  I  goto  500 

alpha-  -hal f*h/chngh 

chngh-o 1 phatchngh 

chngv-a 1 pha*chngv 

500  coni inue 


h-h*chngh 

v-v+chngv 


6£ 


et  sys  f  mal/i2for/sec)  v  forM 

subroui  me  SEC  1 V  Inc  ,z  ,s mb  >cosb  1 1  anb  >secb  ,eps  > icv ) 

tt4^***M****M*t***t***t**t**t  ***********  ***********  ******************* 

implicit  double  precision  (a-h,o-z) 

integer*2  nc  ,icv 

double  precision  z (25  I  ,z ,s inb  ,cosb  , t anb  iSecb  ,eps 
double  precision  vc0(6) 

equ i valence  ( vc0 1  ,vc0 ( II  )  ,  ( vc02  ,vc0(2)  )  ,  I vc03  ,vc0 1  3  )  )  , 

<3  ( vc04  ,vc0 (1)1  ,  ( vc0S  ,vc0 (S  )  1  ,  ( vc06  ,vc0 1 6  )  ) 
integer*2  ni t  ,one  ,nerr  ,nr 
data  one/1/ 

**************  ********************************************  ************** 
hi anb-z l 1  I*  t  anb 
call  VCRI T0lnc  ,z  ,vc0  I 
dkn-z (12) 

call  EST  V  ( nc  ,z  ,s  i  nb  .cosb  ,  tanb  ,v0  ) 

)0C'1  continue 
z(2  )-v0 

coll  CALC  2  ( nc  ,?  ,vc0  .s  mb  ,cosb  ,  t  anb  ,secb  >ht  anb  ,onp  ,nerr  i 
if  (nerr  eq  0)  goto  1090 
nr -nerr -nerr/ 3 

v0-vc0lnr  )+htanb 

goto  1 000 
1 090  con  t i nue 
d0-z (121 

v 1 -VFUN l v0  ,z(  1) I 
z(2  1-vl 

cal  1  CALC2lnc  iZ  ,vc0  >sinb  ,cosb  itanb  ,secb  ,htanb  ,one  ,nerr  I 
d)-z(12) 

n  i  I  -  1 

2000  coni inue 

v2-v) -(d) -dkn ) * ( v 1 -v0  )/(dl -d0 ) 

2 1 00  con l i nue 
z (2  )-v2 

cal  1  CALC2(nc  >z  ,vc0  .sinb  iCOSb  ,tanb  ,secb  ,htanb  ,one  ,nerr  ) 

if  (nerr  eq  0)  goto  2190 

nr-nerr- nerr/3 

v2-0  5d0* ( v 1 ♦ vc0 1  nr  )  *h t anb  ) 


1 


ON 


goto  2100 
2190  coni inue 
d2-z( 12  I 

if  (dabs (d2-dkn )  It  eps 1  goto  5000 

if  (mi  eq  100)  Slop  100 

v0-v  1 

i/ 1  -  v2 

d0-d1 

d  I  -d2 

m i-ni l*l 

goto  2000 

5000  commue 
z ( 12 1-dkn 

if  I  icv  ne  II  goto  10000 

? (2  1-dotan( l anb*dmax 1 (zero  ,  (z (2 1-vc0l -hlonb )/Z (1)1) 

10000  coni inue 
re i urn 


•  fe’ 


ei  svs  f inal/t2for/vcr i t0  fort# 

subroutine  VCR  I T0(nc ,z  ,vc0 1 

******************** ************t******«*» ****************************** 

implicit  double  precision  (a-zl 

integer *2  nc 

double  precision  z(25l.vc0(6) 

double  precision  pi  ,hal fpi  , degrad  .raddeg  ,zero  ,one  ,hal f 
mieger*2  i zero  , i one  , i t wo 

common  /VCONST/  pi  ,hal fpi  idegrad  >raddeg  >zero  ,one  ,hol f  , 

A  izero  ,ione  ,i two 

**************************************************** ******************** 

vc0(2  l-zero 
VC0  (  1  1-2(3  )*zm 
i f (nc  eq  t  Igoto  100 
vc0 ( 1  )-2ero 
vc0 (3l-2(6)*z(71 
vc0 (2  1-2(5  1  *vc0( 3  ) 
vc0M  l-vc0(l  )»vc0(21 
t  f (nc  eq  2  Igoto  100 
vc0(6  l-zero 
vc0I5  1-2 (9  )*z ( 10  ) 
vc0(41-2(8)*vc0(5l 
vc0 ( 3 )-vc0 ( 3  1  +vc0 ( 4  1 
vc0l21-vc0(21*-vc0(4  1 
VC0I1  1-VC01 1  1+VC014) 

1  00  cont  mue 
return 
end 

* 


I 


ON 

-4 


et  svs  f inol / 1 2 for/ 1 ens  fori# 

************************************************************************ 

*  Calculate  slack  lengths  for  one-componen i  simple  leg,  given 

*  d  -  depth  at  anchor  point 

*  cs  -  cosine  of  ocean  floor  angle 
%  sn  -  sine  of  ocean  floor  angle 

*  s  -  scope  of  chain 

*  *  -  1  inear  weight  of  chain 

************************************************************************ 
implicit  double  precision  la-2 1 

«,*«««i**K**«i?s««;««*««**»«******************************* 

1 ens-d-S*sn 

lens- ls-d*sn-dsqrt l 1 ens* 1 ens* lh+h )*cs* 1 ens/w ) )/ (cs*cs ) 

re  t  urn 

end 

* 


I 


ON 

-o 


et  sys  f inal/t2for/vfun  forfl 
function  VFUNIv.h) 

f *********************************************************************** 

implicit  double  precision  (a-zl 

double  precision  vfun,v,h 

tttttttttttt*t*ttttt%***t*****tt**t**t****tttt*t**ttttt*tt*ttttt**t*ttt* 
iflv  110,20  ,30 
10  v fun-0  9d0*v 
goto  100 
20  v fun-0  5d0*b 
goto  100 


it  ‘  7/ 


et  svs  f mal/t2for/calc2  forM 

subrout  me  CALC2(nc  ,z  , vc0  >sinb  >cosb  ,tanb  >secb  ,htanb  indim  ,nerr  ) 
************************************************************************ 
implicit  double  precision  la-zl 

mi eaer*2  nc  ,ndim  ,nerr 

double  precision  z (25  1  ,vc0 (6  I  .s inb >cosb  i tanb  ,secb  ,ht anb 
mteger*2  ipt 

************************************************************************ 
h-Z I  I  ) 
v-z (2 ) 
nerr-0 

iflndim  eq  1  Igoto  100 
htanb-h*  tanb 
I  00  cont inue 

vc I  - vc0 ( I  )+h tanb 
vc2-vc0(2  )*htanb 
i f (nc  eq  1  Igoto  200 
vc3-vc0 ( 3  l+h  tanb 
vc4-vc0<4  l+htanb 
i fine  eq  2  Igoto  200 
vc5-vc0 (5  ) ♦h t anb 
200  con  1 1 nue 

1 1 00  con t inue 

i  f  ( v  It  vc I  1 go  to  1150 

ipt-1 

1-0  0d0 
hw 1 -h/z ( A  1 

tanal - tanb+ ( v- vc 1 l/h 
goto  3100 

I  150  cont inue 

i  five  I  ge  vc2  Igoto  1200 

nerr-1 

goto  6000 

1200  continue 

if(v  It  vc2  Igoto  1250 

ipt-2 

1  -  ( vc  I  -  v  )/zM  I 


1? 


hdl-h/Hli  ) 

z ( 19  I- ianb+ ( v~vc2 1/h 

zf^3l-Ucosb+bwt*dlog(  (z<  19I+sec2)/<  tonb*secbl  ) 
z 1 16 I-l*sinb+hw1 *lsec2-secb 1 
go  t  o  3200 

1 250  cont inue 

i ( Inc  ge  2lgo'o  1260 
nerr-2 
goto  6000 
1260  cont inue 

t  f l vc2  ge  vc3 (goto  1 300 

nerr-3 

goto  6000 


1 300  cont inue 

iftv  It  vc3  lgoto 


1360 


ipt-3 
goto  2000 

1310  T-z l 3 1 

h«2-h/Z(7  I 

z (20 )• tanb* ( v-vc3 1/n 


goto  3300 


I  360  coni inue 

i f ( vc3  ge  vc4 Igo t o 

nerr-4 

goto  6000 


M00 


1 400  cont inue 

l { t  v  It  vc4  lgoto 


1450 


ipt-4 
go  t  o  2000 

1410  T-(vc3-v  l/zl7  1 


hw2-h/z(7) 

z  1 2 1  )  - 1  onb+ ( v - vc 4  1  /h 

zTm  i-Ucosb+b*2*dlogl  (2121  )  +  sec2  l/l  tonb+secb  1 
z ( 1 7  1- 1 *s inb+hw2* 1 sec2-secb I 
l -Jt  1 3  )>  I 
goto  3400 


) 


rv> 


z  1 161-213  1*6  mb 
illipi  eq  3  Igoto  1310 
2(201-1 onb 

iflipi  eq  II goto  14)0 
2(21 l-i onb 
2 ( M  1-2 16  )*cosb 
2  ( 1  7  1-2  16  l*s  mb 
i flip i  eq  5  Igoto  IS  10 
2 (22  1-t onb 
goto  1610 

3100  cont inue 

sec  1 -SECNT ( i onol  I 
2(191-1 ono 1*2(31 /hw I 
sec2-SECNT(z(19> I 

2(13  )-hwl *dlog ( t  z 1 1 9  )*sec2  1/ ( t  onol *sec I  1 1 
2(16)  — hw 1  * ( sec 2~  sec  I  I 
3200  coni inue 

i f (nc  eq  1  Igoto  4100 
b»2-h/2(7l 
2(201-Z(19l*Z(5l/h 
3300  coni inue 

seel -SECNT (z (20) 1 
2(21  )-z  (201*2  (6  )/h*»2 
sec2-SECNT(2(21  )  1 

2(14  )-hw2*dlog ( ( z ( 21  I*sec2  1/ ( 2 (20 l*sec I  1 1 
2 ( I  7 1 -h«2* ( sec2-sec I  1 
3400  cont inue 

i fine  eq  2  Igoto  4200 
h*3-h/z( 10) 

2(221-2(21  1*2(8)  /h 
3500  continue 

seel -SECNT (z (22  I  ) 

2  (23  1-2  (22  1  +  2  (9  )/h\»3 
sec2-SECNT (z (23  1  1 

z ( I S )-h«*3*dlog( (2(23  I*sec2  1/ (z (22 1 *sec 1  1  1 
2(18 )-hw3* (sec2-sec 1  1 
3600  coni mue 

2(11  1-2(131*2(141*2(15) 
2(121-2(161*2(171*2(18) 
goto  5000 
4100  z(11  1-2(13) 


ei  svs  C  mal  /  t2for/eps  1  v  forM 
subroutine  EPSIV 

******************************* ***************************************** 

implicit  integer*2  (»l 
implicit  double  precision  la-2) 

integer  *2  i  leg  nst  ,nca  ,ncb  iti*a  ,n*b  ,  i  so  I  ,  ibrnch  ,uz  (5  ) 
double  precision  z  167  )  ,cz  ,cx  id  , t a  •  tb 

common  /VCLOB/  i  leg  list  ,nca  incb  ;7  (C2  ;cx  idita  itb  in*a  in*b  i 
A  i sol  .  i bench  ,uz 
double  precision  za ( 25  I  ,zb ( 25  I 
equ i valence  ( z ( 1  1  iza ( I  II  ,  ( z  <2 6  )  (zb ( 1  I) 

double  precision  ha  .a t a  ,va  ,s  1  a  ,» 1  a  ,c  1  a  ,s2a  ,*2a  ,c2a  ,s3a  ,*3a  , 

A  xa  ,ya  ,x  1  a  ,x2a  ,x3a  ,y  1  a  iv2a  iy  3a  . 

A  t  ana2a  ,  t  ana3a  ,  t  anala  ,  t  ana5a  1 1  ana6a  ,  1  a  iph  j  a 
equivalence  (zall  I  ,ha  I  ,(za(2l  iala>val  • 

A  ( za  ( 3  )  ,s  I  a  I  ,  ( za  M  I  ,w  1  a  )  ,  ( za  15  )  iC  1  a )  ■ 

A  (za  16  )  ,s2a  )  .  Iza( 7  1  ,w2a  I  ,(  za  18  I  ,c2a  I  , 

A  ( za  19  l  ,s3a  )  ,  (  za  (  1 0  )  ,w3a  I  ,  (za  ( 1 1  I  ,xa  l  ,  I  za  ( I  2  )  ,yal  ■ 

A  (zal  1  5  i  ,x  1  a )  ,  tzo( M  1  ,x2a  I  ,(za(  IS  I  ,x3a  I  , 

A  (zal 16  I  ,ylai  ,  (zal I  7  1  ,y2a  I  ,  I za( 18  )  ,y3a )  , 

A  (zal 191  ,tana2a)  ,(za(20)  ,tana3al  , (zal 21  I  ,  tana* a)  ■ 

A  ( za (22  l  1 1 anaSa  1  ,  l za 123  I  , tana6a )  > ( za (24  1  ,1a)  ,  l za ( 25  )  ,ph is  ) 
double  prec  ision  coil  .sip  •fre  t  ,c5  ,s^  ini'*  ,xi  ,y4  ,  t  ana  7  ,  rana8 , 1  i 
A  h  ,ph  i h  ,r  t o t  ,xtot  iZtot  ,do 

equivalence  (z ( 5 1  )  ,co i 1  )  ,  ( z (52 )  ,slp  1  , 1 z 153  1  ,  fre  t  )  ,  l z (54  )  ,c3  )  , 

A  (z(SS)  ,s4)  >(2(56  1  ,  ( z  (57  I  ,x4)  ,  ( z  (58  )  ,yi)  . 

A  lz<S9l  ,tana7l  ,(z(60)  ,  tona8l  ,lz(61  )  .1  )  . 

A  tz(82)  ,h)  ,(z(63)  ,phihl  , 

A  (z  <61  l  ,r  to t  I  ,  ( z '65  1  ix  tot  I  ,  ( z (66  )  ,z  tot  )  ,  lz (67  i  ,do  ) 
double  precision  b  ,s i nb  ,cosb  ■  t anb  ,secb 

equivalence  (z(25)  ,b  1  ,(z(26)  iSinbl  ,(z(27)  ,cosb)  ,  ( z 1 28  )  ,tanbl  • 

A  ( z (29  1  ,secb  i 
mteger*2  uzl  ,uz2 

equ i va 1 ence  ( uz ( 1  )  >uz 1  )  .  ( uz ( 2  )  ,uz2  ) 

double  precision  pi  .halfpi  , degrad  .roddeg  , zero  , one  ,hal f 
integ er*2  lzero  ,ione  ,i two 

common  /VCONST/  pi  ,hal fpi  , degrad  iraddeg  ,zero  ,one  ihal f  . 

A  i zero  .  i one  ,  1 1  »o 


double  precision  tnaf  ,phif 
common  /VQFlR/  tnaf  ,phi f 


integer*!  ct  it  lei  It 'll 
common  /TITLES/  ctille 

integer*!  cdottm(!6l 
common  /DATIME/  cdat in 

integer*!  ever  in (172) 
common  /VAR IN/  evann 

real  1  la  ,t  lb  >1  1  ,hha  .hhb  ,hh  i 
A  xxla  ,xx3a  ,xxSa  ,xx!b  ,xx3b  ixx5b  ,xx7  ,xx8  » 
A  yyla  ,yy3a  ,yy5a  iyy!b  ,yy3b  .yySb  ,yy7  ,yy8  , 
A  zz la  ,zz3a  ,zzSa  ,zz lb  ,zz3b  ,z2Sb  ,zz 7  ,zz8  , 
A  aala  ,aa2a  iaa3a  ,aa1a  ,aaSa  >aa6a  . 

A  aalb  ,aa2b  ,aa3b  .aalb  ,aaSb  >aa6b  >aa7  ,aa8  > 
A  w  I  a  tw2a  ,w3a  .wTa  iwSa  tw6a  > 

A  wlb  ,w2b  ,w3b  ,w1b  ,vv5b  ,vv6b  ,vv7  ,vv8  > 
A  1 1  la  ,t  t2a  ,t  t3o  .t  tla  .t  tSa  ,t  t6a  , 

A  1 1  lb  .t  f2b  .tt3b  ,» fib  ,t  »Sb  ,tt6b  ,t  t7  ,t  t8  , 
A  ddo  ,dda  ,ddb  , 

A  af  .afdir  ,afa  ,odir  ,afb  ibdir  , 

A  sslp  ,coi  la  ,coi  lb 
integer*2  iisol  ,iibrn 

common  /VAROUT/  1  la  ,1  lb  ,11  ,hha  ,hhb  ,hh  , 

A  xxla  ,xx3a  ,xxSo  ,xxlb  ,xx3b  >xx5b  ,xx7  ,xx8  , 
A  yyla  ,yy3a  ,yy5a  ,yylb  ,yy3b  ,yySb  ,yv7  ,yy8  , 
A  zzla  ,zz3a  ,zzSa  ,zzlb  ,zz3b  ,zz5b  ,zz7  ,zz8  , 
A  aata  ,aa2a  .aa3a  ,aala  ,aa5a  ,aa6a  , 

A  aalb  ,ao2b  ,aa3b  .aalb  ,aa5b  ,aa6b  ,aa7  ,oa8  , 
A  wla  . w2a  ,vv3o  .wla  ,vv5a  ,vv6 a  , 

A  wlb  ,vv2b  ,vv3b  .vvlb  >vv5b  ,vv6b  ,vv7  ,vw8  > 
A  t  i  la  ,t  t2o  .t  t3a  .t  tla  .n5a  ,t  t6a  , 

A  1 1 1 b  1 1 1 2b  ,  1 1  3b  ,  1 1 1b  ,  1 1 5b  ,  1 1 6b  ,  1 1  7  , 1 1 8  , 
A  ddo  ,dda  ,ddb  , 

A  af  .afdir  ,a fa  .adir  ,afb  >bdir  , 

A  sslp  ,coi la  ,coi lb  , 

A  i i sol  >i ibrn 
real  parout(81) 
equ i va 1 ence  ( 1  I  a  .par ou t ) 

integer*!  cvarg(210l 
common  /VARG/  evarg 


integer*)  cunknoll2) 
common  /UNKNOW/  cunkno 

integer*)  caropt  Mi  1 
common  /GROPT/  cgropt 

i n  t  eger *  t  carp? I (218) >cgrp22 ! 82 ) 
common  /GRP2CN/  cgrp2l  ,cgrp22 


i n  t  eger *2  i 

l*******^************************************************************** 

i****^***************************************************************** 

cal  1  RWCOMI ( l  ) 


u2 ( 3  1-0 

if  ( i s  t  eq  11  goto  1 050 
cal  1  ROBACMuzt  ,2) 
goto  1100 
1050  coni inue 

call  RDBACMuzl  ,uz2) 

1100  con  r inue 

call  EL V 1 
t  emp-za 1 2  I 
zat2  l-dtan( temp  I 

cal  1  CTEN1  ( nca  ,za  ,tanb  ,ang  ,ten  ,vten) 
za(2  )-temp 

do  1800  i-l  »8"^ 

par  out  1 i 1-9999  99 
1800  continue 


cosph-dcos 1 ph i h 1 
s i nph-ds i n I ph i h 1 
xx la-0  0 
zzla-0  0 
y y I a-0  0 
aala-angl 1  I 
1 1 lo-tenl I  ) 
wla-vtenl  1  l 


-J 

Oo 


1 


n 


ao2a-ang(2 ) 

1 1 2a- ten (2  I 
v v2a-v t  en { 2  ) 
xx3a-x t  a*cosph 
zz3a-x1a*si nph 
vy 3a-y I  a 

i  f  (nca  eq  1  )  goto  2000 

aa3a-ang(3) 

t  t  3a- ten ( 3  ) 

v v3a-v  t en ( 3  I 

aa4a-ang l 4 ) 

t  t  4a- ten ( 4 ) 

w4a-v  t  en  ( 4  I 

xxSa-(x1a*x2a)*cosph 

zzSa-(x1a*x2al*si nph 

y ySa-y 1 a  +  y2a 

if  (nca  eq  21  goto  2000 

oaSa-ang(SI 

t  1 5a- t  en ( 5  ) 

v v5 a— v t  en ( 5  1 

aa6a-ang (6 1 

t  t6a-ten(6  I 

v v6a- v  t  en ( 6  I 

x  x  7-xa*cosph 

zz  7-xa*s i nph 

y  y  7-y a 

2000  con  t i nue 
1  1  a-  1  a 

hha-ha* I  0d-3 

a  f -do  t  an ( t  na  f  I  *roddeg 

afdir-phi f*raddeg 

a  f  a-b*raddeg 

ad i r-ph i h*raddeg 

ddo-do 

dda-do 

cal  1  RWC0M1 12  1 

re  t  urn 
end 


et  sys  f inal / t2for/rdback  forSJ 
subroutine  ROBACKIul  ,u2  ) 

t*tt*t**t***ttt**t*****t**tttt***t*t**t***t*t*tttttt*ttt*t*ttt****t*tttt 
implicit  double  precision  (a-z) 

integer *2  ul  ,u2 

mteger*2  i  i  1  eg  ,  i  i  s  t 
integeriM  nnca  ,nncb 
r ea 1  ang I  a  .ang 1 b  , 

A  scop  1  a  iScop  I  b  ,wg  t  I  a  ,wg  t  1  b  .c  1  mp  1  a  ,c  1  mp  I  b  , 

A  scop2a  >scop2b  >wg  1 2a  .wg  1 2b  ,c 1 mp2a  iC 1 mp2b  , 

A  scop3a  ,scop3b  ,wg  t  3a  ,wgt  3b  ,s  1  i  p  ,  fr  ic  t  ,c  Imp 3  .scop*!  ,wgt  -1  ,ank  sep  , 

A  pi  x  ,p  1  z  ,p  1  d  ,p2x  ,p2z  ,p2d  ,p3x  ,p3z  >p3d  , 

A  hload  ,hdir  ,rbuoy  ,xbuoy  ,zbuoy  .deptho  ,pdir 
common  /VAR1N/  i  i  1  eg  . '  i  s  t  ,r inca  ,nncb  >ang  1  a  ,ang  1  b  > 

A  scop  1  a  ,scop  I  b  ,wgt  Ta  .wgt  lb  ,c  Imp  I  a  ,c  1  mpl  b  , 

A  scop2a  ,scop2b  ,wgt  2  a  ,wgt2b  idmp2a  ,clmp2b  , 

A  scop3o  ,scop3b  ,wg  t  3  a  .wgt  3b  ,s  1  i  p  ,  fr  i  c  t  .cl  mp3  >scop4  ,wgt  ■1  ,ank  sep  , 

A  pi  x  ,p  I  z  ,p  I  d  ,p2x  ,p2z  ,p2d  ,p3x  ,p3z  ,p3d  , 

A  hload  ,hdir  .rbuoy  .xbuoy  .zbuoy  .dept ho  .pdir 
real  parinl30) 
equivalence  ( ang I  a  ,par i n  I 

integer *2  i  leg  ,ist  ,nca  ,ncb  .nwa  ,nwb  ,isol  .ibrnch  ,uz  (5  1 
double  precision  z (67  1  .cz  .ex  ,d  .  t a  ,  t b 

common  /VGLOB/  i  leg  .ist  ,nca  ,ncb  .z  .cz  .ex  ,d  ,ta  ,tb  .nwa  .nwb  , 

A  i so  1  ,  i brnch  ,uz 
double  precision  za  125  1  .zb (25  I 
equivalence  ( z 1 1  1  .za < 1  1  1  ,  ( z I  26  I  ,zb (1  1  1 

double  precision  ho  ,a  I  a  .va  .s  1  a  .w  1  a  >c  1  a  .s2a  ,w2a  >c2o  ,s3o  ,w3a  . 

A  xa  .va  .x  1  a  .x2a  .x3o  .V  1  a  .y2o  .v3a  . 

A  t  ano2o  .  t ana3a  .  t  anoAa  ,  t  ana5a  ,  t  ono6a  .  I  a  .ph i a 
equ  i  valence  ( za  ( 1  1  ,ha  I  .  ( za  1 2  1  ,a  1  a  .va  1  > 

A  (  za  ( 3  1  ,s  1  a  I  ,  IzaM  1  >w  I  a  I  .( za  15  I  ,c  I  a  I  . 

A  (  za  (6  )  ,s2a  )  ,  1  za  1  7  1  ,w2o  1  , 1  za  18  )  ,c2o  1  . 

A  1  za  1 9  1  .s3a)  .  1  za  1 1 0  1  .w3ol  ,  1  za  1 1 1  1  >xal  .(zo(l21  .va)  > 

A  f  za  113)  .xlo)  ,  1  za  1  M  I  .x2a  1  >(zo(l5l  ,x3a)  . 

A  ( za 1 16  )  ,y I  a  )  .  ( za 1 l 7  1  ,y2a  )  .  1 za 1  I  8  1  .v3a  1  . 

A  1 za 119)  ,tano2a)  ,(za(20l  .tana3a)  .(zal21  1  ,tono3a)  , 

A  l za 1 22  )  ,  t  anoSo  1  , 1 za (23  1  .  t ana6a I  .  1 za  1 23  1  ,1a)  >(za(25)  ,ph i a  1 
double  precision  hb  .alb  .vb  >s  1  b  .w  1  b  >c lb  >s2b  >w2b  .c2b  ,s3b  ,w3b  . 

A  xb  ,yb  ,x  I  b  ,x2b  .x3b  >y  I  b  ,y2b  ,y3b  , 


&  i  ana2b  ,  t  ana3b  ,  t  ana^b  >  t  ana5b  ,  i  ana6b  ,  1  b  >ph  i  b 
equ  1  va  1  ence  ( zb  ( I  I  ,hb  I  ,  ( zb  1 2  )  ,a  1  b  >vb  )  , 

A  (zb  131  ,s  1  b  1  ,(zbH)  ,w1b)  ,<zb(S)  ,clbl  , 

A  ( zb  (6  1  ,s2b  1  ,  ( zb  (  7  I  ,w2b  )  ,(zb(8)  ,c2b  1  , 

A  (zb  (91  ,s3b)  ,  ( zb  (10)  ,w3b  )  >  l  zb  (  1  I  )  ,xb  )  ■  ( zb  ( 1 2  >  iyb)  , 

A  l  zb  ( I  3  I  ,x  1  b  1  ,  ( zb  l  M  1  ,x2b  )  ,  (zbl  15  )  ,x3b  1  , 

A  (zb( 16  1  ,y lb  I  ,(zb( 1 7  1  lV2b  1  ,  (zb (18  1  ,y3b  1  , 

A  ( zb (19)  ,tana2bl  ,  I  zb (20)  ,tana3b)  ,  (zb(21  1  ,  tanalbl  , 

A  (zb(22)  iiana5bl  ,lzb(23)  ,tana6b)  ,tzb(21)  ,1b)  ,(zb<25)  ,phib) 
double  precision  coil  ,slp»frct,c3»s1,w4,x4,y<,t  ana  7  ,  t  ana8  , 1  , 

A  h,phih,rtot  ,xtot  ,zioi  ,do 

equ  i  va  1  ence  ( z  (5 1  )  ,coil  1  ,(z(52)  ,slp)  ,  (  z (53 )  ,frct  1  ,  ( z 1 54  )  ,c3)  , 

A  ( z (55  I  ,s4  )  ,  ( z (56  I  ,w4 )  , (z (57 1  ,x4  )  , ( z (58  1  ,yi  1  , 

A  ( z ( 59  1  ,  i ana  7  I  ,  ( z ( 60  1  ,  i ana8  1  ,  ( z  1 6 1  I  ,1  1  , 

A  l  z  (62  1  ,h)  ,  ( z  (63  1  ,phih  1  , 

A  (z (64  1  ,r  to i  )  ,  ( z (65  I  ,x loi  1  ,  (z (66  1  ,z  tot  )  ,  (z 167  1  ,do  ) 
doub 1 e  precision  b  ,s i nb  ,cosb  , t anb  ,secb 

equ i va 1 ence  ( z ( 25  !  ,b  1  ,  ( z  1 26  1  ,s  t  nb 1  ,  i z  1 27  1  ,cosb  1  , 1 z ( 28  1  ,  t  anb  1  , 

A  l z (29  I  ,secb  I 

double  precision  pi  .halfpi  .degrad  .raddeg  .zero  ,one  ,ba 1 f 
i n l eger *2  i zero  ,  i one  ,  i t  wo 

common  /VCONST/  pi  .halfpi  .degrad  .raddeg  .zero  , one  ,hal f  , 

A  i zero  ,  lone  ,  i t  wo 

i n  t  eger *2  commap (12)  ,  i t  ab 1  ,  i ) ob2  ,  i  ,u 
data  commap/ 34  ,1  ,3  ,5  ,7  ,9 , 1  1  , 1  3  , 1 5  , 1  7  ,36  ,39/ 

************************************************************************ 
i t  ab 1 -commap lull 
i t  ab2-commap l u2  I 
i-i t  abl 
u-u  1 

I  00  con  t i nue 

go i o ( 1 1 0  , 1 20  , 1 30  , ! 30  , 1 1 0  , 1 30  , 1 30  , 1 1 0  , 1 30  , 1 30  , 1 30  , 1 30  )  ,u 

110  par  in ( i  )-z (u  1*0  001 
goto  150 

120  par  in ( i  I- ( z lu  1 -b  )*raddeg 
qo  t  o  1 50 

I  30  ijar  ml  i  l-z  (u  ) 

1  50  com  inue 

i flu  eq  u2)qoto  200 

i - i t  ab2 

u-u2 


et  svs  f  inol/t2for/elvl  forM 
subrout me  EL VI 

implicit  integer *2  (“I 
implicit  double  precision  (a-zl 

double  precision  1  la  ,1  lb  ,1 1  ,  fanna  ,  tannb ,  rannr  , 

4  xxla  ,xx3a  ,xx5a  ,xx3b  ,xx5b  ,xx7  ,xx8  , 

4  gall  ,ga!2,ga2l  ,ga22,ga3l  .ga32  . 

4  gbl I  >gbl2  ,gb2l  ,qb22  ,gb3l  ,gb32  > 

4  gl  ,g2  ,xfa  ,xfb  ,xf 

common  /VARG/  1 1  a  ,  1  lb  ,  1 1  , t anna  ,  t annb  , t annr  , 

4  xxla  ,xx3a  ,xx5a  ixx3b  ,xx5b  ,xx7  ,xx8  , 

4  gall  ,gal2,ga21  ,ga22  ,ga31  ,ga32  , 

4  gbl I  ,gbl2  ,gb2l  ,qb22  ,gb31  .gb32  , 

4  gl  ,g2  ,x  fa  ,x  fb  ,x 7 

inteaer*2  i leg  >ist  ,nca  .neb  ,nwa  ,nwb  ,isol  .ibrnch  ,uz 15 ) 
double  precision  zl67  1  ,cz  ,cx  ,d  ,ta  ,tb 

common  /VGLOB/  i  leg  .ist  .nca  ,ncb  .z  .cz  ,cx  ,d  ,ta  .tb  ,nwa  ,nwb  , 

4  isol  .ibrnch  ,uz 
double  precision  za<25  I  ,zb(25  I 
equ i va 1 ence  I z 1 1  )  .za I  I  ))  ,  ( z ( 26  )  ,zb  t I  1  ) 

double  precision  ha  .  at  a  ,va  .si  a  >wl  a  .da  >s2a  .w2a  ,c2a  .s3a  .w3a  . 

4  xa  ,ya  .x  I  o  ,x2a  ,x3a  .y  I  a  .y2a  ,v3a  , 

4  t  ana2a  .  t  ana3a  ,  t  anala  .  t  anaSa  .  t  ana6a  .  1  a  >ph  i  a 
equ i valence  (za  1 1  )  ,h a  )  ,(za(2)  .ala.va)  . 

4  ( za  ( 3  )  .s  I  a  I  .IzaHl  ,w  1  a  1  .  ( za  ( 5  )  .c  I  a  )  . 

4  (za(6)  ,s2a)  ,lza(7)  ,»2a)  .(za(8)  .c 2a)  , 

4  ( za  (9  )  ,s3a  1  .  ( za  1 1 0  )  ,w3a  I  .  ( za  ( 1 1  )  .xo  )  .(za(l2)  .y  a  )  , 

4  (za(  I  3  )  ,x la  )  ,  ( za (  M  )  ,x2a  )  ,  (za < !  5  I  .x3a  )  , 

4  Iza  1 16  )  .y I  a  l  ,  I zal 1 7 1  ,y2a  I  .  (za 1 18  I  .y 3a  )  . 

4  ( za ( 1 9 )  ,  t ana2a I  ,  ( za ( 20 )  ,  t ana3a )  ,  ( za ( 2 1  )  ,  t anala  I  , 

4  ( za (22  )  .  t ana5a  )  .  ( za (23  I  .  tana6a  1  ,  (za ( 21  I  >lal  . (zal 25)  >phia ) 

double  precision  b  ,stnb >cosb  ,tanb  ,secb 

equivalence  ( z (25  1  ,b  )  ,  ( z (26  I  .s  mb  )  ,  ( z ( 27  )  ,cosb  )  ,  ( z 128  )  ,  t anb  )  . 

4  (z(29  )  ,secb  ) 

double  precision  pi  .halfpi  .degrad  .raddeg  .zero  .one  ,hal f 
i n t eger *2  i zero  . i one  a  two 

common  /VCONST/  pi  , halfpi  .degrad  .raddeg  .zero  .one >hol f  > 

4  i zero  .1 one  .i two 

tttt*tt*tt****ttt*t*tt*t*t*t«*tSt*tt**ts****M*******t*t***t************ 
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et  sys  f mal/t2for/gcoef f  forU 

subroutine  GCOEFFtnc  .z.tanb.gll  >g12>g2t  ,g22  ,g3l  ,g32,ileg) 

*****:M************************ ********************** ******************* 
implicit  integer*2  (») 
implicit  double  precision  (a-zl 

inieaer*2  ncdleg 

double  precision  z ( 25  I  .  t anb  ,gl  I  ,g  1  2  ,g2 1  .g22  ,g3 1  .g32 

double  precision  pi  .halfpi  .degrad  .raddeg  .zero  .one  .ha  1  f 
integer*2  i zero > i one  , l t wo 

common  /VCONST/  pi  ,hal fpi  .degrad  .raddeg  .zero  .one  , ha 1 f  , 

A  izero  .ione  ,i two 

************************************************************************ 

secb-SECNT ( t  anb 1 
s i nb- t  anb/secb 
cosb-one/secb 
h-z ( 1  1 
s 1 -z ( 3  ) 
s 2-z (6  ) 

y !-Z( I6J 
y2-zM7! 

1 -z (21 ) 

if  < !  ge  s I  1  goto  100 
it  (1  at  zero  1  goto  310 
tno-z (2  1 

if  ( i 1 eq  eq  1  )  t  na-d  t  an ( t  na  ) 
x-zero 
y-zero 
goto  320 
310  cont inue 
t  na- 1  anb 
x-l*cosb 
y-l*stnb 
320  cont inue 
x-zero 

sca-SECNT ( tna ) 
w-z ( 1  1 

g I  1  —  t  t na+ sco  l*dexpl-w*x/h) 
gl2-v- (h*sco/w ) 

100  cont  mue 

if  (nc  eq  II  goto  600 


Oo 

^1 


if  (1  ge  s1+s2)  goto  500 
if  (1  gt  si)  goto  410 
t  na-z (20  ) 
x-ze<~o 
y-y  I 

goto  420 
410  cont inue 
i na- t  anb 
x- ( 1 -si  )*cosb 
y- 1  *s  mb 
420  cont inue 
x-zero 

sca-SECNT ( ina) 
w-z ( 7  1 

g21 -  1 tna+sca  )*dexp  (-w*x/h  1 
g22-y- (h*sca/w ) 

500  cont inue 

if  (nc  eq  2 )  goto  600 
if  ( 1  gt  s I +s2 >  goto  510 
tna-Z (22  I 
x-zero 
v-y 1 *y2 
goto  520 
510  cont  mue 
i na- t  anb 

x-  1 1 -s 1 -s2  )*cosb 
y- 1 *s inb 
520  cont inue 
x-zero 

sca-SECNT (tna l 
W-Z (10) 

g31 - l tna+sca )*dexp ( -w*x/H ) 
g32-y- (h*sca/w 1 
600  cont inue 


ret  urn 
end 


et  sys  f i nal / 1 2 for/c ten  I  forJ4 

subrouf ine  CTENI (nc  ,z  ,1 onb ,ang  , ten  ,vtenl 

implicit  double  precision  la-z I 

integer *2  nc 

double  precision  z!2S)  ,  tanb  , ang 16)  .  ten(6)  ,vten(6) 

double  precision  pi  .halfpi  .degrad  .raddeg  .zero  ,one  ,hal f 
integer*2  i  zero  ,  i one > i t *o 

common  /VCONST/  pi  ,hal fpi  .degrad  .raddeg  .zero  .one  ,hal f  , 

A  izero  ,ione  . i two 

mteger*2  ic  ,m  ,j 

************************************************************************ 

tenl  i«l-hsecb-«*smb 

t  en2  (aa  ,»»  )  -  (h/dcos  (aa  1  )*dcos  laa-b  t  -w#*s  i  nb 

h-z(  l  ) 
si -z(3  l 
•  1-zHI 
c I -z (5 ) 
s2-z (6 ) 

*2-z  1 7  ) 

-2-z 18  ) 
s3-z (9 ) 
f5-zll0i 
l-z(24  ) 

secb-SECNT ( t  anb  I 
s i nb- t anb/secb 
b-dotanl tanb  I 
hsecb-h*secb 

ang ( I  ) -da tan ( z (2  )  ) 
ang ( 2  I -da  t  an ( z ( 1 9  1  I 
if  Inc  eq  I  )  goto  1000 
ang 1 3 l-da tan  I z (20  I  ) 
ang (4  1  -da » on  I z ( 2 )  )  ) 
i I  (nc  eq  21  goto  (000 
ang ( 5 ) -da  t  an ( z ( 22  I  ) 
ang (6  I -do tan ( z (23  l  l 
1000  continue 


if  (1  eq  0  0d0 )  goto  1710 
if  (1  ge  si)  goto  1 300 
I en ( I) - l enl  ( wl*  1  ) 
goio  1720 

1 300  con  f i nue 

if  (1  g t  si)  goto  1 400 
t en l I  I- i en2 tong (3)  ,w  1  *s  1  +c  1  ) 
t  en ( 2  )  - 1  en2 ( ang (31  >c  1  ) 
goto  1 730 

1400  conf  i  nue 

if  (1  ge  s1»s2)  goto  1500 

wg  1 2-w 2* f 1  —  s 1  ) 

lent  I  )-ten1  ( w 1 *s 1 +  c 1 +  wg 1 2  ) 

ten (2  I- l enl (cl +  wgt2  ) 

if  (nc  eq  1  )  goto  1 7g0 

l en ( 3  I - i enl ( wg 1 2  ) 

goto  1740 

1  500  com  mue 

if  (1  gt  sl*s2l  goto  1600 
wg  1 2-w2*s2*c2 

ten ( 1  1- t  en2 long (5  1  ,w 1 *s 1 *C 1 »wg 1 2  ! 
t en ( 2  ) - ten2 ( ang 15  )  .c1*wgt21 
if  ( nc  eq  II  goto  1790 
t  en ( 3 ) - t  en2 ( ang ( 5  )  iwa  1 2  ) 
t  en  1 4  I  - 1  en2  ( ang  ( 5  )  iC2  ) 
goto  1750 

1600  continue 

wgt  3-w3* ( 1  - s 1 -s2  ! 
wgt 2-c 1 ♦w2*s2*c2  +  wgt  3 
t  en ( 1  )  - t  en 1 t  w 1 *s 1 +  wg  1 2  ) 
t en ( 2 )- t en I ( wgt 2  ) 
if  (nc  eq  ')  goto  1790 
ten(3)-tenl (wgt 2-c 1 ) 
t  en (4 )- 1 enl (c2*wgt  3  I 
if  (nc  eq  2)  goto  1790 
ten (5  1- ten  1 (wgt 3  I 
goto  1 760 


OO 

OQ 


1710  cont inue 

lend  )-h*SECNT  ( z (2  )  ) 

1 720  corn  inue 

t  en  <  2  I -htSECNT ( z ( 1 9 ) 1 
1730  continue 

i  f  (nc  eq  1  I  goto  1 790 
t en ( 3  l-h*SECNT ( z  <20  )  ) 

1 730  cont inue  „  , . 

tenM  )-h*SECNT  ( z (2 1  I  I 
1  750  cont inue 

i f  (nc  eq  2 )  goto  1 790 

tenl5)-h»SECNT(z(22)l 

1 760  cont inue 

i en ( 6  I -h*SECNT ( z ( 23 1  I 
1 790  cont inue 


do  1010  i c- 1 .nc 
do  1810  j~  1  >2 

in-2* 1 iC-1 • ♦ J 
tent inl-tenl t  n I  *  1  0d-3 
vient in i- tent  m  Itdstnlangl ini) 
ang( in  )«ang( in )*reddeg 
1810  continue 


re  t  urn 
end 


END 

DATE 

FILMED 


